前回の
Bricscad VBAを使ってみよう[5] VBAの基本コード②
からの続篇です。
図面でデーターをもとに作図したり、データーを図面から抽出したりする時に、Excelと連動して作業できればとても効率的です。
VBAを使う方法は、BricsCADVBAでExcelと連携する場合と、ExcelVBAでBricsCADと連携することができます。
今回は、BricsCADVBAでExcelと連携する場合を検討しました。
EXCELVBAでBricsCADと連携する場合は次回以降で検討しています。・・・が結構私好みです^^
1,基本設定
まず初めに、Excelのタイプライブラリに対して参照設定を行います。
BricsCADのVBE画面 → Tools → Referlences
Microsoft Excel 16.0 ObjectLibrary にチェックしてOKボタンです。
(数字部分はExcelのバージョンで異なります)
参照設定とは、外部ライブラリとして提供されるオブジェクトを使用する場合に、事前にその外部ライブラリへの参照を設定しておくことを言います。
この参照設定は、dvbファイルに設定が保存されますので以降は設定不要ですが、新たに作成する場合は設定が必要です。
Excelオブジェクトの構成
Excelと連携するため、この表の一番下にあるセルとデーターのやり取りが出来るようにします。
【手順】
Excelのオブジェクト変数を宣言
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
(ここでは、複数のWorkbooks、Worksheetsは扱わず、1つのブック、1つのシートで進めます)
Excelを新規に起動する場合
Set xlApp = CreateObject(“Excel.Application”)
実行中のExcelに接続する場合
Set xlApp = GetObject(, “Excel.Application”)
GetObject(ファイルの完全パスと名前 , クラス)
クラスでExcel.Applicationを指定し、パスを省略しています。
省略時は起動中のExcelの参照を取得します。
単 一の Workbook オブジェクト の取得は 、Workbooks (index) ですが、ここでは起動中の1つのブックだけを扱いますので、ActiveWorkbookとctiveSheetを取得します。
Set xlbook = xlApp.Workbooks.Add(Template)
引数(Template)を省略すると、空白のシートを含む新しいブックが作成されます。
Set xlSheet = xlbook.Worksheets.Item(Index)
Worksheets.Item(インデックス番号)もしくはWorksheets.(インデックス番号)
インデックス番号では、左側から順に1.2.3・・・となり、並びを変えると左からの
番号が変わります。”Sheet1”等のワークシート名で指定すると並びを変えても取得できます。
![]()
左から1・2・3・4・・・・で、”Sheet1″のインデックスは1番
![]()
左から1・2・3・4・・・・で、”Sheet1″のインデックスは2番
に注意が必要です。
Range(“セル番地”).Value = (数字、文字)
=の右側の変数がInteger型やString型のようにプロパティやメソッドを持たない型を代入する場合はSetは不要です。
しかし、代入する変数にメソッドやプロパティがある場合はSetが必要になります。
例)セル範囲を代入する場合
‘オブジェクト変数を宣言
Dim CRng As Range
‘変数にセル範囲を代入
Set CRng = Range(“A1:A10”)
‘セル範囲を赤色に変える
CRng.Interior.Color = vbRed
2,作業用のExcelを取得する
Moduleを作成して、VBマクロのコードをModule内に記述します。
具体的にBricsCAG\DVBAからExcelを起動してみます。
2-1,ブックが開かれていた場合
ブックが開かれていなかった場合は、新規にブックを開きます。
Sub GetExcel_Sample()
''Excelのオブジェクト変数を宣言
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error Resume Next
''実行中のインスタンスに接続
Set xlApp = GetObject(, "Excel.Application")
''実行中のインスタンスがない場合(error'429')
If Err.Number <> 0 Then
Err.Clear
''新規にインスタンスを生成
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add()
Set xlSheet = xlbook.Worksheets.Item("Sheet1")
End If
'Excel画面の表示
xlApp.Visible = True
Set xlbook = xlApp.ActiveWorkbook
Set xlSheet = xlApp.ActiveSheet("Sheet1")
End Sub
ブックを開いていなかったので新規ブックが開きました。
Book1-Excel が開いて、sheet1 の Reng(“A1”)がアクティブな状態で起動しました。直接新規で空白のブックを開いた時と同じです。
2-2,既存のブックを開く場合
例えば、Dドライブのvbaフォルダー内のTestExcelを開く場合
Set xlbook = xlApp.Workbooks.Add(“D:\vba\TestExcel.xlsx”)
Addメソッド以外にOpenメソッドも同様に使用できます。
Sub GetExcel_Sample2()
''Excelのオブジェクト変数を宣言
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
''エラー処理を無効にする
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add("D:\vba\TestExcel.xlsx")
If Err.Number <> 0 Then
Err.Clear
MsgBox "ファイルがありません"
Exit Sub
End If
Set xlSheet = xlbook.Worksheets.Item("Sheet1")
'Excel画面の表示
xlApp.Visible = True
Set xlbook = xlApp.ActiveWorkbook
Set xlSheet = xlApp.ActiveSheet
End Sub
3,エクセル終了時のオブジェクト変数の処理
3-1,変数の有効期間
Set オブジェクト変数 = オブジェクト名
オブジェクト型で宣言したオブジェクト変数に、オブジェクトへの参照を格納します。
vBマクロ終了時に、オブジェクトへの参照を解除する必要があります。
変数には有効期間があり有効期間が終了すると、オブジェクトへの参照が正常に解除されますが、プロシージャレベル変数の場合は「End Sub」です。
モジュールレベル変数は「宣言セクション」で宣言された変数で、同モジュール内のすべてのサブルーチンのプロシージャで使用できる変数のことです。
参照するプロシージャがいくつもあったり、変数の数が多い場合はモジュールレベル変数を使いますが、メインルーチンのプロシージャを抜けても値は破棄されず参照が可能です。
Set オブジェクト変数 = Nothing
オブジェクト変数と参照先のオブジェクトへの参照が無効になりますが、参照先のオブジェクトをメモリ上から削除することではありません。オブジェクト変数に、参照情報が代入されていない初期状態です。
変数の型の違い
【参照型】
参照型は「参照情報を格納する」変数で、オブジェクトの実態が有る場所の情報(参照情報)が格納されます。
【値型】
値型は、変数にデータそのものが入っています。例えば、「Dim X As Integer」「X = 5」とした場合、変数”X”には整数の5が直接格納されます。
上記のExcelを開くコードでは、Excelのオブジェクト変数はSubプロシージャ内の宣言になりますのでNothingの記述は不要です。
宣言セクションでオブジェクト変数を宣言し、サブルーチンを使うような場合では、Excelの終了時は確実に終了処理を行う必要があります。
4,エクセルとの連携
4-1,CAD画面で取得した座標値をExcelに送る
CAD画面でクリックした座標値のデーターをExcelに送ってみます。
操作は、任意の個所をクリック、ESCキーで終了です。
空白のsheet1に、1行目にタイトル、2行目以降に各クリックしたポイントのXYZ座標を取得します。
例として図形の頂点座標を取得してみました。
取得する座標値は、始点を(0,0,0) として各点座標値を取得します。
Sub BcadVBAtoExcel_Sample01()
''【Exvelの変数を宣言】
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error Resume Next
''【ActiveWorkbookを取得する】
Set xlApp = GetObject(, "Excel.Application")
''Workbookが開かれていない場合は新規に作成する
If Err.Number <> 0 Then
''Errオブジェクトをクリア
Err.Clear
''新規にExcelのインスタンスを生成
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.Workbooks.Add()
Set xlSheet = xlbook.Worksheets.Item("Sheet1")
End If
'Excel画面の表示
xlApp.Visible = True
Set xlbook = xlApp.ActiveWorkbook
Set xlSheet = xlApp.ActiveSheet
'' BricsCADの画面をアクティブ
Dim BcadCaption As String
BcadCaption = ThisDrawing.Application.Caption
AppActivate BcadCaption
'' 【座標値を取得】
Dim GetCnt As Long
GetCnt = 1
Do
On Error Resume Next
'' Bricscad画面の任意の点座標を取得
Dim pt() As Double
pt = ThisDrawing.Utility.GetPoint(, "画面をクリック:")
If Err Then
Err.Clea
Set xlSheet = Nothing
xlbook.Close
Set xlbook = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub
End If
If GetCnt = 1 Then
''初回の座標値を残しておく
Dim pm(0 To 2) As Double
pm(0) = pt(0): pm(1) = pt(1): pm(2) = pt(2)
''セルを中央揃えにする
xlSheet.Range("A:D").HorizontalAlignment = xlCenter
''タイトル記入
xlSheet.Cells(1, 1).Value = "No"
xlSheet.Cells(1, 2).Value = "X"
xlSheet.Cells(1, 3).Value = "Y"
xlSheet.Cells(1, 4).Value = "Z"
End If
Dim Row As Integer
Dim i As Integer
''座標値記入行を1行ずらす
Row = GetCnt + 1
''1列目に連番
xlSheet.Cells(Row, 1).Value = GetCnt
''2.3.4列目にX,Y,X座標値をセルに代入するときに、初回座標値を減じて0,0,0点からの開始とする。
For i = 2 To 4
If i = 2 Then
pt(i - 2) = pt(i - 2) - pm(0)
ElseIf i = 3 Then
pt(i - 2) = pt(i - 2) - pm(1)
ElseIf i = 4 Then
pt(i - 2) = pt(i - 2) - pm(2)
End If
''2.3.4列目にX,Y,X座標値をい記入
xlSheet.Cells(Row, i).Value = pt(i - 2)
xlSheet.Cells(Row, i).NumberFormatLocal = "0.000"
Next
GetCnt = GetCnt + 1
Loop
End Sub
終了時にブックを保存するようにしました。
Set xlSheet = Nothing
xlbook.Close
Set xlbook = Nothing
xlApp.Quit
Set xlApp = Nothing
ESCキーで終了時にxlbook.Closeで保存のダイアログが出ます。
タクスバーのアイコンがテカテカ点滅してます^^
![]()

xlbook.Close のかわりに、
例えば、SaveAsを使って、Dドライブのvbaフォルダー内に「BcadVBAtoExcel_Sample01.xlsx」のファイル名で保存する場合は、
xlbook.SaveAs (“D:\vba\BcadVBAtoExcel_Sample01.xlsx”)
で、一瞬で保存されます。
ブック保存時では、Save、SaveAs、Close、Quitで、多様な設定がありますので状況で保存方法を調整できます。
4-2,座標値をExcelから取得する
次に、Excelに取得した座標データーを取得してポリラインを描画してみます。
保存したブックを先に開いてから、実行してください。座標値を読み込んでポリラインを作図します。
Sub BcadVBAtoExcel_Sample02()
''【Excelの変数を宣言】
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error Resume Next
''【ActiveWorkbookを取得する】
Set xlApp = GetObject(, "Excel.Application")
''Workbookが開かれていない場合は警告して終了する
If Err.Number <> 0 Then
MsgBox "bookが開かれていません"
Exit Sub
End If
Set xlbook = xlApp.ActiveWorkbook
Set xlSheet = xlApp.ActiveSheet
'' Bricscadをアクティブ
Dim BcadCaption As String
BcadCaption = ThisDrawing.Application.Caption
AppActivate BcadCaption
'' 画面の図形挿入点=原点にする
Dim ps() As Double
ps = ThisDrawing.Utility.GetPoint(, "図形挿入位置をクリック:")
'1行目をタイトルにしているので2行目からNoを取得する
Dim Row As Integer
Row = 2
Dim MaxCnt As Integer
''Noの列で空欄があればループを抜ける
Do
If xlSheet.Cells(Row, 1).Value <> "" Then
MaxCnt = xlSheet.Cells(Row, 1).Value
Else
Exit Do
End If
Row = Row + 1
Loop
''座標値を格納する変数を宣言
Dim pt As Variant
ReDim pt(0 To MaxCnt * 3 - 1) As Double
'Dim i As Long, j As Long, k As Long
Dim i As Integer, j As Integer, k As Integer
''座標値をポイントごとに変数に格納する
i = 0
For j = 2 To MaxCnt + 1
For k = 2 To 4
pt(i) = xlSheet.Cells(j, k).Value
pt(i) = pt(i) + ps(k - 2)
i = i + 1
Next
Next
''3Dポリライン作図
Dim objPoly As AcadPolyline
Set objPoly = ThisDrawing.ModelSpace.AddPolyline(pt)
'作図図形範囲にZoom
ThisDrawing.Application.ZoomExtents
'図面を更新
ThisDrawing.Application.Update
End Sub
先ほど作成した矢印の先端部をクリックして、座標データーから一筆書きでポリラインを描きます。
次回は、ExcelVBAでBricsCADと連携する場合を検討しました。
BricsCAD VBAを使ってみよう[7] Excelとの連携②
coffee break

今回は、BricsCADのVBAでExcelと連携することを検討しました。
ExcelVBAでBricsCADと連携する方も進めていますが、ExcelVBAでの構文はBricsCADVBAの場合の構文で一部ちょこっと変わるだけです。
どちらかというと、ExcelVBAでBricsCADと連携する方がいいような感じですが、
・・・・見慣れているのもあるのかも^^
BricsCAD VBAを使ってみよう INDEX
BricsCAD VBAを使ってみよう[1] VBAのインストール
BricsCAD VBAを使ってみよう[2] UserFormその1
「BricsCAD VBA 」Creating UserForm
BricsCAD VBAを使ってみよう[3] UserFormその2
「BricsCAD VBA 」SerialNumber drawing with UserForm
BricsCAD VBAを使ってみよう[4] VBAの基本コード①
BricsCAD VBAを使ってみよう[5] VBAの基本コード②
BricsCAD VBAを使ってみよう[6] Excelとの連携①
「BricsCAD VBA to Excel」Get_CoordinateValues
BricsCAD VBAを使ってみよう[7] Excelとの連携②
「Excel VBA to BricsCAD」Get_Area
BricsCAD VBAを使ってみよう[8] Excelとの連携②-2
「Excel VBA to BricsCAD」Draw_ChannelSteel
BricsCAD VBAを使ってみよう[9] TABLEの自動作成と値入力
「BricsCAD VBA 」AutomaticCreation of TABLE
BricsCAD VBAを使ってみよう[10] Excelとの連携②-3
「Excel VBA to BricsCAD」SerialNumber_Ⅱ
BricsCAD VBAを使ってみよう[11] Excelとの連携②-4
「Excel VBA to BricsCAD」Draw_Rectang
BricsCAD VBAを使ってみよう[12] Excelとの連携②-5 指定画層にOffset
「Excel VBA to BricsCAD」Continuous Offset to Specified Layer
BricsCAD VBAを使ってみよう[13] Excelとの連携②-6 指定画層にHATCH
「Excel VBA to BricsCAD」Continuous Hatch to Specified Layer
BricsCAD VBAを使ってみよう[14] Excelとの連携②-7 長さ計測
「Excel VBA to BricsCAD」Length measurement
BricsCAD VBAを使ってみよう[15] Excelとの連携②-8 画層状態コントロール
「Excel VBA to BricsCAD」layer contr
以下検討中です。
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
「この特集記事の内容につきましては、
こちらの環境のみの検討結果です。
動作保証は出来かねますため、ご参考
資料としてお扱いください。
Windows10(64bit)
BricsCAD pro V20(64bit)
Office2019(64bit)
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇








