前回の
Bricscad VBAを使ってみよう[5]　VBAの基本コード②
からの続篇です。

図面でデーターをもとに作図したり、データーを図面から抽出したりする時に、Excelと連動して作業できればとても効率的です。

VBAを使う方法は、BricsCADVBAでExcelと連携する場合と、ExcelVBAでBricsCADと連携することができます。

今回は、BricsCADVBAでExcelと連携する場合を検討しました。

１，基本設定

まず初めに、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つのシートで進めます）

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・2・3・4・・・・で、”Sheet1″のインデックスは２番
に注意が必要です。

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”には整数の５が直接格納されます。

上記のExcelを開くコードでは、Excelのオブジェクト変数はSubプロシージャ内の宣言になりますのでNothingの記述は不要です。

宣言セクションでオブジェクト変数を宣言し、サブルーチンを使うような場合では、Excelの終了時は確実に終了処理を行う必要があります。

4，エクセルとの連携

4-1，CAD画面で取得した座標値をExcelに送る

CAD画面でクリックした座標値のデーターをExcelに送ってみます。

操作は、任意の個所をクリック、ＥＳＣキーで終了です。

空白のsheet1に、1行目にタイトル、２行目以降に各クリックしたポイントのＸＹＺ座標を取得します。

例として図形の頂点座標を取得してみました。

取得する座標値は、始点を（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

ＥＳＣキーで終了時に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行目をタイトルにしているので２行目から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その１
「BricsCAD VBA 」Creating UserForm

BricsCAD VBAを使ってみよう[3]　UserFormその２
「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）
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇