HinoADO xiki | 外部変形の作り方

外部変形の作り方

※Hinoのスキルは大したことないというのを前提に、気になるところはスルーしながら眺めてください。

とりあえず小型モジュール集に幾つかのサンプルスクリプトを記述してありますのでそれを組み合わせて、画像をトレースした敷地形状を、指定の面積に調整する「R敷地」を作ってみます。

元になるデータは↑こんなのです。

面積算定ルーチンでは多角形ソリッド図形の面積取得が気楽なので、敷地図は線要素とソリッド図形要素で描画したものを取り扱うことにします。

それではやってみます。

まずエクセルをJWWの外部変形から呼び出すためにBATファイルをとりあえず作ってみます。

R敷地.BAT

@rem R敷地(敷地面積を整合させます)
@echo off

REM #jww JWW用外部プログラム宣言

REM #h2 選択方法

REM #cd 外変と同じフォルダにjwc_temp.txtを出力する

REM #hc 敷地の元になる輪郭線とソリッドを選択して下さい

REM #g0 書き込みグループレイヤ対象
REM #e

start /w excel R敷地.xls

BATファイルの書き方はJWW_SMPL.BATファイルに全て書いてありますので熟読して下さい。

今回は面積を取り扱うので、異縮尺を取り扱わないように書き込みグループのデータのみ(#g0)取り扱います。

上記BATファイルの最後の行でエクセルファイルの起動を記述してあります。

エクセルをエンジンとして使う場合にはなぜかファイル名の前に「start
/w 」の記述がないとうまくいかないことが多いのでこれはお約束として書いておきます。

JWWでこのBATファイルを呼び出すと、JWWは選択されたデータを「jwc_temp.txt」というファイルに書き出して、外部プログラムの処理が終了するまでじっと待ってくれます。

そのJWWが待ってくれている間にエクセルに何かをさせるのが外部変形です。

まず具体的な処理方法をプランしてみます。

　　１．ソリッド図形の面積を集計

　　２．集計した結果を表示し、整合させるべき面積を入力

　　３．拡大率を座標に掛けて、基準点に基づいて書き出し

こんな感じで良さそうです。

それではまずファイルオープン時にマクロを実行させましょう。

Private Sub Workbook_Open()

　　sikiti
End Sub

今回のメインルーチン名は「sikiti」にしました。

これをどこに記述するかといいますと

ここから「Visual Basic Editor」を立ち上げて

この「ThisWorkbook」にペーストします。

ペーストしました。

これでこのファイルは起動時に「sikiti」というマクロが実行されます。

このままでは「sikiti」のスクリプト内容を記述する場所がありませんので「標準モジュール」を挿入します

適当なところで右クリックして出てくるメニューから選んで下さい

無事挿入されました。

この「Module1」に外変本体を色々と仕込んでいきます。

外部テキストの参照方法からスクリプトを貼り付けてみます。

（以降追加された部分を太字で表示します)

スクリプト本体

Sub sikiti()

pth=thisworkbook.path
Dim tf
Set tf = CreateObject("Scripting.FileSystemObject")

Set tf_txt = tf.OpenTextFile(pth & "\jwc_temp.txt", 1, True)

Do Until tf_txt.AtEndOfStream

tmp = tf_txt.readline '１行読み込み

'ここに処理を記述

Loop

End Sub

これにまず

　　１．ソリッド図形の面積を集計

の処理を記述してみます。

この手の単純なルーチンは転用も効かせ易いのでサブルーチンとして仕込みます。

ここでは多角形ソリッド図形の面積取得を使うことにします。

Sub solid_s_get(tmp, s)
temp = tmp & " 0 0"
s = 0
a = Split(temp)
If UBound(a) = 8 Then a(7) = a(1): a(8) = a(2)
If UBound(a) >= 8 And a(0) = "sl" Then

x0 = Val(a(1)) '各座標を格納
x1 = 0
x2 = (a(3) - x0) / 1000
x3 = (a(5) - x0) / 1000
x4 = (a(7) - x0) / 1000
y0 = Val(a(2))
y1 = 0
y2 = (a(4) - y0) / 1000
y3 = (a(6) - y0) / 1000
y4 = (a(8) - y0) / 1000

la1 = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
la2 = Sqr((x2 - x3) ^ 2 + (y2 - y3) ^ 2)
la3 = Sqr((x3 - x4) ^ 2 + (y3 - y4) ^ 2)
la4 = Sqr((x4 - x1) ^ 2 + (y4 - y1) ^ 2)
la5 = Sqr((x3 - x1) ^ 2 + (y3 - y1) ^ 2)

sh1 = (la1 + la2 + la5) / 2
s1 = Sqr(sh1 * (sh1 - la1) * (sh1 - la2) * (sh1 - la5))
sh2 = (la3 + la4 + la5) / 2
s2 = Sqr(sh2 * (sh2 - la3) * (sh2 - la4) * (sh2 - la5))

s = s1 + s2

End If
End Sub

↑これをサブルーチンに置いておきます。

もう一つモジュールを追加してそこに貼り付けたり、スクリプト本体の下に置いたり適当にどうぞ。

このサブルーチンを使って面積を集計するルーチンを記述してみます。

スクリプト本体

Sub sikiti()

pth=thisworkbook.path
Dim tf
Set tf = CreateObject("Scripting.FileSystemObject")

Set tf_txt = tf.OpenTextFile(pth & "\jwc_temp.txt", 1, True)
solid_menseki=0

Do Until tf_txt.AtEndOfStream

tmp = tf_txt.readline '１行読み込み

call solid_s_get(tmp, s)
solid_menseki = solid_menseki + s

Loop

End Sub

これで選択されたデータ内のソリッド図形面積集計は完了です。

サブルーチンがあるのでえらい楽です。

ここでは jwc_temp.txt を最初の行から最後の行まで全ての中に存在する多角形ソリッドの面積を拾い出しました。

このまま
　　２．集計した結果を表示し、整合させるべき面積を入力

に進んでみます。

スクリプト本体

念のため数値以外が入力された場合は終了するようにしました。

面積で取得した倍率を線分要素に当てはめていくために平方根を取っておきました。

最後は

　　　　３．拡大率を座標に掛けて、基準点に基づいて書き出し
です。

その前に作図原点を指示するようにした方が便利そうですね。

これはBATファイルでの指示になりますからBATファイルに書き込んでおきます。

R敷地.BAT

@rem R敷地(敷地面積を整合させます)
@echo off

REM #jww JWW用外部プログラム宣言

REM #h2 選択方法

REM #cd 外変と同じフォルダにjwc_temp.txtを出力する

REM #hc 敷地の元になる輪郭線とソリッドを選択して下さい

REM #g0 書き込みグループレイヤ対象
REM #0 元図の拡大縮小基準点を指定して下さい

REM #1 拡大縮小後の作図位置を指定して下さい
REM #e

start /w excel R敷地.xls

これでBATファイルはOKです。

忘れないウチに作図原点を取得する部分を記述してみます。

スクリプト本体

これで x と y に指示された作図原点の座標を格納できました。

ここでは jwc_temp.txt を最初の行から最後の行まで観察して基点情報を拾い出しました。

本当は最初の十数行だけ観察すれば充分なのですが手抜きです。

それでは出力方法を考えてみます。

元図にあるソリッドは無くて良いですね。

そうすると線分要素だけで済みそうです。

線種・線色・レイヤは書き込み属性を使いましょうか。

とりあえずファイルの書き出しからスクリプトを持ってきましょうか。

スクリプト本体

このままではjwc_temp.txtを上書きしてしまいますね。

もう少しjwc_temp.txtは使う予定なので違うファイル名で書き出すことにします。

スクリプト本体

これでjwc_temp.txtと同じフォルダに r_temp.txt
というファイルで出力する準備が出来ました。

ここでもう一度jwc_temp.txtを開いて、線分データだけを拾い出して加工してみます。

線分データはヘッダが半角スペースで座標が4つだけですから簡単ですし。

スクリプト本体

Sub sikiti()

pth = ThisWorkbook.Path
Dim tf
Set tf = CreateObject("Scripting.FileSystemObject")

Set tf_txt = tf.OpenTextFile(pth & "\jwc_temp.txt", 1, True)
solid_menseki = 0

Do Until tf_txt.AtEndOfStream

tmp = tf_txt.readline '１行読み込み

s = 0
Call solid_s_get(tmp, s)
solid_menseki = solid_menseki + s

Loop

menseki = InputBox("現在の面積は "
& Round(solid_menseki, 2) & "㎡
です．変換する面積を入力して下さい")
If IsNumeric(menseki) = False Then End
bairitsu = Sqr( menseki / solid_menseki )

Set tf_txt = tf.OpenTextFile(pth & "\jwc_temp.txt", 1, True)

Do Until tf_txt.AtEndOfStream

tmp = tf_txt.readline '1行読み込み

If Left(tmp, 3) = "hp1" Then '基点情報検索

a = Split(tmp) '半角スペースで切り分け

x = a(3) '3番目 = x

y = a(4) '4番目 = y
End If

Loop

Set fs = CreateObject("Scripting.FileSystemObject")
Set r_tmp = fs.CreateTextFile(pth & "\r_temp.txt", True)
Set tf_txt = tf.OpenTextFile(pth & "\jwc_temp.txt", 1, True)

Do Until tf_txt.AtEndOfStream

tmp = tf_txt.readline '1行読み込み
header = Left(tmp, 1)

If header = " " Then '線データの処理
a = Split(tmp)

x1 = Val(a(1)) * bairitsu + x '拡大縮小処理
y1 = Val(a(2)) * bairitsu + y
x2 = Val(a(3)) * bairitsu + x
y2 = Val(a(4)) * bairitsu + y
tmp = " " & x1 & " " & y1 & " " & x2 & " " & y2

r_tmp.writeline (tmp) '線分をファイルに出力
End If

Loop
r_tmp.Close

End Sub

だいぶできあがりました。

あとはファイルを保存せずにエクセルを終了するコードを足しておきましょうか。

スクリプト本体

そう言えば先程出力ファイルを r_temp.txtに変えたので、この処理をBATファイルに記述しておきます。

R敷地.BAT

@rem R敷地(敷地面積を整合させます)
@echo off

REM #jww JWW用外部プログラム宣言

REM #h2 選択方法

REM #cd 外変と同じフォルダにjwc_temp.txtを出力する

REM #hc 敷地の元になる輪郭線とソリッドを選択して下さい

REM #g0 書き込みグループレイヤ対象

REM #0 元図の拡大縮小基準点を指定して下さい

REM #1 拡大縮小後の作図位置を指定して下さい
REM #e

start /w excel R敷地.xls
del jwc_temp.txt
ren r_temp.txt jwc_temp.txt
del r_temp.txt

さあ以上で外部変形がひとつ出来上がりました。

あとなんかしたいですね。

線分の両端に点でも打ちますか。

スクリプト本体

とりあえず点が重なりますが気にしないことにします。

あとせっかくなので元の面積と処理後の面積を記録しましょう。

スクリプト本体

以上でひとまず完成です。

本来は後々トレースしやすいようにTABやコメントで可読性を向上させておくのですが、htmlではTABがうまく使えなかったのであえてはずしてあります。

全体もそう長くないのでコメントも省きました。

サンプルのJWWデータと、ここまでで作成したR敷地.BATとR敷地.xlsは念のためここに置いておきます。

Hino 18:04 2006.11.14 Tuesday

新しい記事