AutoCAD LTをExcelでコントロール


路線図作成

  

'' **********************************************
'' Module2
'' **********************************************
Sub ボタン3_Click()
Dim Fsize, i As Integer '整数型の変数の宣言
Dim Fname, X, Y, No, Xy, Moji As String '文字列型の変数の宣言

'scr(スクリプトファイル)の場所を[C:\ExAcad\CadData\]に指定しています。
'CadDataのフォルダの中身は、[ExAcad2.zip]から取得して下さい。
'他のフォルダ(例:MyData)にするときは、[C:\MyData\]と指定します。

Fname = "C:\ExAcad\CadData\rosen.scr"
'scr(スクリプトファイル<rosen.scr>)を事前に作成しておきます。
'ファイルが読み書き出来るモードで開きます。

Open Fname For Output As #1
'Excelのデータが2行目から始まるので、行の初期値を<2>に設定します。
i = 2
Print #1, "-osnap non"
'新規画層を作成します。
Print #1, "-layer n Kessen n point c 1 point n no c 5 no "
Print #1, "pdmode 3"
Print #1, "pdsize 3"
Print #1, "zoom a"
'i が99でなかったら、以下の処理を行います。
While i <> 99
No = Cells(i, 1) 'No
X = Cells(i, 2) 'X座標
Y = Cells(i, 3) 'Y
'座標は XとYの組み合わせなので、1つの文字列に結合します。
Xy = X & "," & Y
' Noのセルが空白でなかったら、以下の処理を行います。
If "" <> No Then
'現在層を[Point]に設定します。
Print #1, "Clayer Point"
'取得した座標の位置に、点(Point)を落とします。
Print #1, "Point " & Xy
'現在層を[No]に設定します。
Print #1, "Clayer No"
'取得した座標の位置に、2.5ミリの大きさで<No>の文字を記入します。
Print #1, "Text " & Xy & " 2.5 0 " & No
'ポイント点上に測点名を描きます。
Moji = Moji + Xy & Chr(13)
i = i + 1
Else
i = 99
End If
Wend
Print #1, "Clayer Kessen"
'現在層を[Kessen]に設定します。
Print #1, "Line " & Moji
'ポイント点から次のポイント点へ結線します。
Print #1, "zoom e" 'オブジェクト範囲ズームする
Print #1, "filedia 1"
'ファイルを閉じます。
Close #1

'AutoCAD をアクティブにします。
'[SetAcadCtrl]はExcelからAutoCAD LTをコントロールする標準モジュールです。
'SendKeysは不安定ですが、これはLTへ確実にコマンドを送信できます。
SetAcadActive
'AutoCAD のコマンドラインに、スクリプトを送ります。
SendAcadCommand ("filedia 0" + Chr(13) + "script" + Chr(13) + Fname + Chr(13))
SendAcadCommand ("filedia 1" + vbCr)

End Sub