AutoCAD VBA：別図面からのブロック定義のディープクローン

[#1]

Issue

現在オープンしている図面に配置されている "TEST" ブロック参照を、別の図面に定義されている同じ名前のブロック定義を元に置き換えたいのですが、AutoCAD VBA で可能でしょうか？ 

Solution

AutoCAD VBA で現在の図面上のブロック参照を置き換えるには、置き換え対象のブロック定義を持つ図面をオープン後、ブロック定義を現在の図面にディープクローン、同ブロック定義を元にブロック参照を挿入する必要があります。

この場合、ディープクローン前に現在の図面から置き換え対象のブロック定義と、同ブロック定義を元に挿入されているブロック参照を削除しておく必要があります。

現在の図面（ブロック参照を置き換える図面を図面 A、置き換えるブロック定義を含む外部図面を図面 B とすると、おおまかに次のような手順となります。

1. 図面 A を変数に保存
2. 図面 A 上で対象となるブロック参照数を把握
3. 図面 A 上で対象となるブロック参照の挿入パラメーターをオブジェクト変数に保存
4. 図面 A 上で対象となるブロック参照のを削除
5. 図面 A 上で対象となるブロック定義を削除
6. ブロック定義をディープクローンするため図面 B をオープン
7. 図面 B 上でディープクローンするブロック定義を変数に保存
8. 対象となるブロック定義を CopyObjects メソッド でディープクローン
9. 図面 B をクローズ
10. ディープクローンしたブロック定義を元に保持したパラメーターで挿入

この実装例は次の通りです。

 クラス モジュール（Parameters クラス定義）：

Option Explicit

' ブロック参照パラメーター
Public X As Double
Public Y As Double
Public Z As Double
Public XS As Double
Public YS As Double
Public ZS As Double
Public R As Double

Private Sub Class_Initialize()
    X = 0#
    Y = 0#
    Z = 0#
    XS = 0#
    YS = 0#
    ZS = 0#
    R = 0#
End Sub

プロシージャ：

Public Sub ReplaceBlock()
        
    ' 図面 A を変数に保存
    Dim A As AcadDocument
    Set A = ThisDrawing.Application.ActiveDocument

    ' 図面 A 上で対象となるブロック参照数を把握
    Dim target As String
    target = "TEST"
    Dim entity As AcadEntity
    Dim block As AcadBlockReference
    Dim length As Integer
    length = 0
    For Each entity In A.ModelSpace
        If entity.ObjectName = "AcDbBlockReference" Then
            Set block = entity
            If block.Name = target Then
                length = length + 1
            End If
        End If
    Next

    ' 図面 A 上で対象となるブロック参照の挿入パラメーターをオブジェクト変数に保存
    Dim index As Integer
    index = 0
    ReDim params(length - 1) As Parameters
    For Each entity In A.ModelSpace
        If entity.ObjectName = "AcDbBlockReference" Then
            Set block = entity
            If block.Name = target Then
                Set params(index) = New Parameters
                params(index).X = block.InsertionPoint(0)
                params(index).Y = block.InsertionPoint(1)
                params(index).Z = block.InsertionPoint(2)
                params(index).XS = block.XScaleFactor
                params(index).YS = block.YScaleFactor
                params(index).ZS = block.ZScaleFactor
                params(index).R = block.Rotation
                index = index + 1
            End If
        End If
    Next
    
    ' 図面 A 上で対象となるブロック参照のを削除
    For Each entity In A.ModelSpace
        If entity.ObjectName = "AcDbBlockReference" Then
            Set block = entity
            If block.Name = target Then
                block.Delete
            End If
        End If
    Next
    
    ' 図面 A 上で対象となるブロック定義を削除
    A.Blocks.Item(target).Delete
        
    ' ブロック定義をディープクローンするため図面 B をオープン
    Dim B As AcadDocument
    Set B = A.Application.Documents.Open("<your_own_path>\B.dwg")

    ' 図面 B 上でディープクローンするブロック定義を変数に保存
    Dim objCollection(0) As Object
    Set objCollection(0) = B.Blocks.Item(target)
    
    ThisDrawing.Application.ActiveDocument = A
    
    ' 対象となるブロック定義をディープクローン
    Dim retObjects As Variant
    retObjects = B.Database.CopyObjects(objCollection, A.Blocks)
    
    ' 図面 B をクローズ
    B.Close
    
    ' ディープクローンしたブロック定義を元に保持したパラメーターで挿入
    Dim insertionPnt(0 To 2) As Double
    For index = 0 To length - 1
        insertionPnt(0) = params(index).X
        insertionPnt(1) = params(index).Y
        insertionPnt(2) = params(index).Z
        Set block = A.ModelSpace.InsertBlock(insertionPnt, target, params(index).XS, params(index).YS, params(index).ZS, params(index).R)
    Next

End Sub