AutoCAD VBA：オブジェクト間の関係を維持した図面間のコピー

[#1]

Issue

現在オープンしている図面の図形を別の図面にコピーしたいのですが、コピー元の図形が参照している画層や線種を一緒にコピーすることは出来ますか？

もし、可能なら、寸法をコピーする際に参照している寸法スタイルを、テキスト文字をコピーする際に参照している文字スタイルを同時にコピー出来ると便利です。

Solution

AutoCAD には、オブジェクトの参照関係（つながり）を維持したままコピーをおこなう ディープクローン という機構が存在しています。

ディープクローンを使用すると、図形そのもののコピーだけでなく、そのオブジェクトが参照している他のオブジェクトも深く（ディープ）参照して、元の状態を維持したまま対象図形を別の図面にコピーすることが可能です。例えば、図面 A の線分が同じ図面の ”通り芯” 画層している場合、その線分を図面 B にディープクローンすると、”通り芯” 画層も一緒に、そして、自動的にコピーしてくれます。寸法スタイルや文字スタイルも同様にコピーされます。

VBA が利用する ActiveX オートメーションでは、CopyObjects メソッド でディープクローンを利用することが出来ます。

 次の VBA マクロはタイル状に並べた左側の図面のモデル空間の図形を、右側の図面にディープクローンするものです。VBA マクロ実行前、右側の図面には図形や画層はありませんが、図形のディープクローン時に画層もコピーされていることがわかります。  

Public Sub DeepClone()
    Dim A As AcadDocument
    Set A = ThisDrawing.Application.ActiveDocument
    Dim B As AcadDocument
    Set B = ThisDrawing.Application.Documents.Item(1)
    
    ThisDrawing.Application.ActiveDocument = A
    
    Dim entity As AcadEntity
    Dim retObjects As Variant
    Dim index As Integer
    Dim length As Integer
    ReDim objCollection(0 To A.ModelSpace.Count - 1) As Object

    index = 0
    For Each entity In A.ModelSpace
        ThisDrawing.Utility.Prompt (vbCrLf & entity.ObjectName)
        Set objCollection(index) = entity
        index = index + 1
    Next
    retObjects = A.Database.CopyObjects(objCollection, B.ModelSpace)
    ThisDrawing.Application.ActiveDocument = B
    For index = 0 To length
        retObjects(index).Update
    Next
    B.Application.ZoomExtents
End Sub

•  AutoCAD ActiveX オートメーションでは、ディープクローン先に参照している画層やスタイルがあると、画層やスタイルのディープクローンはおこなわれません（上書きはしません）。