AutoCAD VBA：拡張エンティティ データの付加・参照・削除

[#1]

Issue

VBA で拡張エンティティ データを付加・参照・削除するには、それぞれ、どのようなマクロを作成すればいいでしょうか？

Solution

拡張エンティティ データは、AutoCAD 図面内の任意のオブジェクトに任意のカスタム データの付加、参照する手法です。

AutoCAD の標準コマンドは、付加された拡張エンティティ データを認識しないので、標準ユーザー インタフェースに値が表示されることはありませんが、逆に、ユーザから付加された固有データを隠蔽することが可能です。また、プログラムを介在させない限り、拡張エンティティ データを削除したり、値を変更したりすることができないので、ユーザーによる改変を防止することもできます。

 次のコードは、拡張エンティティ データを付加する SetXData マクロ、参照する GetXData マクロ、削除する RemoveXData マクロの例です。

Public Sub GetXData()

    'オブジェクト選択
    Dim ptPick As Variant
    Dim oEnt As Object
    Dim oUtil As AcadUtility
    Set oUtil = ThisDrawing.Utility
    oUtil.GetEntity oEnt, ptPick, "拡張オブジェクトデータを参照する図形を選択:"
    
    '拡張オブジェクトデータ取得
    Dim vXDataType As Variant
    Dim vXDataValue As Variant
    oEnt.GetXData "MYDATA", vXDataType, vXDataValue
    If VarType(vXDataType) = vbEmpty Then
        oUtil.Prompt (vbCrLf & "拡張オブジェクトデータ 'MYDATA' が付加されていません...")
    Else
    
        'データ表示
        oUtil.Prompt (vbCrLf & "年齢は " & CInt(vXDataValue(2)))
        oUtil.Prompt (vbCrLf & "身長は " & CDbl(vXDataValue(3)))
        oUtil.Prompt (vbCrLf & "体重は " & CDbl(vXDataValue(4)))
        oUtil.Prompt (vbCrLf & "人相は " & CStr(vXDataValue(5)))
    
    End If

End Sub

Public Sub SetXData()

    'オブジェクト選択
    Dim ptPick As Variant
    Dim oEnt As Object
    Dim oUtil As AcadUtility
    Set oUtil = ThisDrawing.Utility
    oUtil.GetEntity oEnt, ptPick, "拡張オブジェクトデータを付加する図形を選択:"
    
    '拡張オブジェクトデータ取得
    Dim vXDataType As Variant
    Dim vXDataValue As Variant
    oEnt.GetXData "MYDATA", vXDataType, vXDataValue
    If VarType(vXDataType) <> vbEmpty Then
        oUtil.Prompt (vbCrLf & "既に拡張オブジェクトデータ 'MYDATA' が付加されています...")
    Else
                
        '入力
        Dim nAge As Integer
        oUtil.InitializeUserInput (7)
        nAge = oUtil.GetInteger(vbCrLf & "年齢を入力(整数):")
        Dim dHeight As Double
        oUtil.InitializeUserInput (7)
        dHeight = oUtil.GetReal(vbCrLf & "身長を入力(実数):")
        Dim dWeight As Double
        oUtil.InitializeUserInput (7)
        dWeight = oUtil.GetReal(vbCrLf & "体重を入力(実数):")
        Dim strLooks As String
        strLooks = oUtil.GetString(True, vbCrLf & "人相を入力(文字):")
        
        'データ付加
        Dim nDataType(0 To 6) As Integer
        Dim vDataValue(0 To 6) As Variant
        nDataType(0) = 1001                       'アプリケーション名
        vDataValue(0) = "MYDATA"                  'アプリケーション名
        nDataType(1) = 1002                       'コントロール文字
        vDataValue(1) = "{"                       'コントロール文字
        nDataType(2) = 1070                       '年齢（整数）
        vDataValue(2) = nAge                      '年齢（整数）
        nDataType(3) = 1040                       '身長（実数）
        vDataValue(3) = dHeight                   '身長（実数）
        nDataType(4) = 1040                       '体重（実数）
        vDataValue(4) = dWeight                   '体重（実数）
        nDataType(5) = 1000                       '人相（文字）
        vDataValue(5) = strLooks                  '人相（文字）
        nDataType(6) = 1002                       'コントロール文字
        vDataValue(6) = "}"                       'コントロール文字
        oEnt.SetXData nDataType, vDataValue

    End If

End Sub

Public Sub RemoveXData()

    'オブジェクト選択
    Dim ptPick As Variant
    Dim oEnt As Object
    Dim oUtil As AcadUtility
    Set oUtil = ThisDrawing.Utility
    oUtil.GetEntity oEnt, ptPick, "拡張オブジェクトデータを削除する図形を選択:"
    
    '拡張オブジェクトデータ取得
    Dim vXDataType As Variant
    Dim vXDataValue As Variant
    oEnt.GetXData "MYDATA", vXDataType, vXDataValue
    If VarType(vXDataType) <> vbEmpty Then
        
        'データ付加
        Dim nDataType(0) As Integer
        Dim vDataValue(0) As Variant
        nDataType(0) = 1001                      'アプリケーション名
        vDataValue(0) = "MYDATA"                 'アプリケーション名
        oEnt.SetXData nDataType, vDataValue
    
    Else
        oUtil.Prompt (vbCrLf & "拡張オブジェクトデータ 'MYDATA' が付加されていません...")
    End If

End Sub

• 1 オブジェクトへの付加サイズ総量が 16 キロバイトまでに制限されています。
• 削除したい拡張エンティティ データのアプリケーション名を SetXData メソッドで上書きすると、同じアプリケーション名の拡張エンティティ データを削除することが出来ます。
• 付加されている拡張エンティティ データは、Express Tools の XDLIST コマンドで参照することが出来ます。