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 コマンドで参照することが出来ます。