AutoCADLT on Excel

　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のデータが２行目から始まるので、行の初期値を<２>に設定します。 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の組み合わせなので、１つの文字列に結合します。 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

路線図作成

'' **********************************************
'' 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のデータが２行目から始まるので、行の初期値を<２>に設定します。
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の組み合わせなので、１つの文字列に結合します。
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