文字入力 |
---|
Private Sub CommandButton1_Click() 'UserForm1を呼び出します。 UserForm1.Show End Sub |
Private Sub UserForm_Activate() 'UserForm1が開かれた時に、ComboBox1に項目を追加します。 ComboBox1.AddItem "配置図" ComboBox1.AddItem "平面図" ComboBox1.AddItem "立面図" ComboBox1.AddItem "断面詳細図" ComboBox1.AddItem "かなばかり図" 'UserForm1が開かれた時に、ComboBox3に項目を追加します。 ComboBox3.AddItem "1" ComboBox3.AddItem "5" ComboBox3.AddItem "10" ComboBox3.AddItem "50" ComboBox3.AddItem "200" End Sub ''------------------------------------------------------------------------------------------------------------------------------------- Private Sub ComboBox1_Change() Dim i As Integer 'ComboBox1の項目が選択されたとき、ComboBox2に項目を追加します。 ComboBox2.Clear i = 2 Select Case ComboBox1.Value Case "配置図" Col1 = 1 Case "平面図" Col1 = 2 Case "立面図" Col1 = 3 Case "断面詳細図" Col1 = 4 Case "かなばかり図" Col1 = 5 End Select While i <> 99 Moji = Cells(i, Col1) If "" <> Moji Then 'ComboBox2にその下に書いてある文字を追加していきます。 ComboBox2.AddItem Moji i = i + 1 Else '99まで対応しています。 i = 99 End If Wend End Sub ''------------------------------------------------------------------------------------------------------------------------------------- Private Sub CommandButton1_Click() Dim Sname As String 'scr(スクリプトファイル)の場所を[C:\ExAcad\CadData\]に指定しています。 'CadDataのフォルダの中身は、[ExAcad2.zip]から取得して下さい。 '他のフォルダ(例:MyData)にするときは、[C:\MyData\]と指定します。 Sname = "C:\ExAcad\CadData\moji.scr" Moji = ComboBox2.Value Taka = ComboBox3.Value If Moji <> "" And Taka <> "" Then Moji = ComboBox2.Value 'scr(スクリプトファイル<rosen.scr>)を事前に作成しておきます。 'ファイルが読み書き出来るモードで開きます。 Open Sname For Output As 1 '文字を記入します。 Print #1, "text 0,0 " & Taka & " 0 " & Moji Print #1, "zoom e" Print #1, "filedia 1" '[MOVE]コマンドを使います。 Print #1, "move l 0,0" Print #1, "zoom p" 'ファイルを閉じます。 Close #1 'AutoCAD をアクティブにします。 '[SetAcadCtrl]はExcelからAutoCAD LTをコントロールする標準モジュールです。 'SendKeysは不安定ですが、これはLTへ確実にコマンドを送信できます。 SetAcadActive 'AutoCAD のコマンドラインに、スクリプトを送ります。 SendAcadCommand ("filedia 0" + Chr(13) + "script" + Chr(13) + Sname + Chr(13)) SendAcadCommand ("filedia 1" + vbCr) Else MsgBox ("「文字か文字高」が選択されていません") Exit Sub End If End Sub ''------------------------------------------------------------------------------------------------------------------------------------- Private Sub CommandButton2_Click() End End Sub |