前回は角度を参照して回転、移動、ｺﾋﾟｰすることを検討しましたが、今回はその続きで、参照した角度でブロックを挿入します。

Excelの事前設定は、前回、BricsCAD VBAを使ってみよう[16]　Excelとの連携②-9　回転＆移動orｺﾋﾟｰ　をご参照ください。

基本設定

Worksheet の設定

前回の方位マークをブロックにして、角度を参照してブロック挿入しています。

垂直方向が基準の為、回転の角度を換算しています。

画層名一覧、ブロック名一覧取得に関しては、前回をご参照ください。
ちなみに回転用のシートとは別シートにしていますので、回転用のWorksheet に有るComboboxには画層一覧のリストは取得されていません。

ThisWorkbookに記述した、Excelのbookを開いた時に自動実行させるWorkbook_Open()のコードは、オープン時のWorksheet に有効のようです。

作図用のメインプロシージャ

ブロック挿入用のプロシージャです。

Sub Insert_block()

''BricsCADのオブジェクト変数を宣言
Dim BcadApp As BricscadApp.AcadApplication
Dim BcadDoc As BricscadApp.AcadDocument

''現在開いているBricsCADを取得する
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")
BcadApp.Visible = True
Set BcadDoc = BcadApp.ActiveDocument


''現在の画層名を取得
Dim CurLyr As String
CurLyr = BcadDoc.ActiveLayer.Name
''作図用画層名を取得
Dim SelLyr As String
SelLyr = ActiveSheet.ComboBox1.Value
''挿入ブロック名
Dim Insblk As String
Insblk = ActiveSheet.ComboBox2.Value

''挿入角度
Dim PI As Double
PI = WorksheetFunction.PI()
Dim Ang As Double
Ang = Cells(4, 2).Value * PI / 180

''BricsCADのキャプションを取得
    Dim BcadCaption As String
    BcadCaption = BcadDoc.Application.Caption


''===========================================
''作図実行
''===========================================

'' BricsCADの画面をアクティブ
    AppActivate BcadCaption

On Error Resume Next

''作図開始点を取得
Dim pt() As Double
    pt = BcadDoc.Utility.GetPoint(, "図形挿入点をクリック:")

''ｷｬﾝｾﾙの場合
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
            GoTo Errline
        End If

''ﾌﾞﾛｯｸの変数設定
Dim blockRefObj As AcadBlockReference

''ブロック挿入
        Set blockRefObj = BcadDoc.ModelSpace.InsertBlock(pt, Insblk, 1, 1, 1, Ang)
        ''InsertBlock(挿入位置, ブロック名, Xscale, Yscale ,Zscale, 回転「ラジアン」)
        '' 画層変更
        If SelLyr <> CurLyr Then
            blockRefObj.Layer = SelLyr
            blockRefObj.Update
        End If
''図面を更新
BcadDoc.Application.Update

Errline:
Set BcadDoc = Nothing
Set BcadApp = Nothing

End Sub
・

・・・実際は、

”挿入ブロック名
Dim Insblk As String
Insblk = ActiveSheet.ComboBox2.Value

で、ComboBoxから取得するのはムズいので、

Excelのシート活用で、７行目からブロック名をずら～っと並べて、
アクティブセルから取得するようにしています。
Insblk = ActiveCell.Value

と言うつまらない落ちでした。。。。

又、ブロックの連続挿入に関しては、複数のブロックを一定の規則に従って挿入座標を計算しながら、一気に並べれるように設定して使用しています。

 

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」Get Length

BricsCAD VBAを使ってみよう[15]　Excelとの連携②-8　画層状態ｺﾝﾄﾛｰﾙ
「Excel VBA to BricsCAD」LayerStatusControl

BricsCAD VBAを使ってみよう[16]　Excelとの連携②-9　回転＆移動orｺﾋﾟｰ
「Excel VBA to BricsCAD」Rotate & move or copy

BricsCAD VBAを使ってみよう[17]　Excelとの連携②-10　ﾌﾞﾛｯｸ回転挿入
「Excel VBA to BricsCAD」Rotate & insert block

 

以下検討中です。

◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
「この特集記事の内容につきましては、
こちらの環境のみの検討結果です。
動作保証は出来かねますため、ご参考
資料としてお扱いください。
Windows11（64bit）
BricsCAD pro V21（64bit）
Office2019（64bit）
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇