概要 - 拡張データを割り当て、取得する(VBA/ActiveX)

拡張データ(xdata)を、図面内のオブジェクトのリンク情報として利用できます。

選択セット内のすべてのオブジェクトに拡張データを割り当てる

次の例では、図面からオブジェクトを選択するよう指示するプロンプトを表示します。選択したオブジェクトが選択セットに入れられ、指定した拡張データが選択セット内のすべてのオブジェクトにアタッチされます。

Sub Ch10_AttachXDataToSelectionSetObjects()
 ' Create the selection set
 Dim sset As Object
 Set sset = ThisDrawing.SelectionSets.Add("SS1")
 
 ' Prompt the user to select objects
 sset.SelectOnScreen
 
 ' Define the xdata
 Dim appName As String, xdataStr As String
 appName = "MY_APP"
 xdataStr = "This is some xdata"
 Dim xdataType(0 To 1) As Integer
 Dim xdata(0 To 1) As Variant
 
 ' Define the values for each array
 '1001 indicates the appName
 xdataType(0) = 1001
 xdata(0) = appName
 '1000 indicates a string value
 xdataType(1) = 1000
 xdata(1) = xdataStr
 
 ' Loop through all entities in the selection
 ' set and assign the xdata to each entity
 Dim ent As Object
 For Each ent In sset
 ent.SetXData xdataType, xdata
 Next ent
End Sub

選択セット内のすべてのオブジェクトの拡張データを表示する

次の例では、前の例でアタッチした拡張データを表示します。文字列(タイプ 1000)以外の拡張データをアタッチする場合は、このコードを変更する必要があります。

Sub Ch10_ViewXData()
 ' Find the selection created in previous example
 Dim sset As Object
 Set sset = ThisDrawing.SelectionSets.Item("SS1")
 
 ' Define the xdata variables to hold xdata information
 Dim xdataType As Variant
 Dim xdata As Variant
 Dim xd As Variant
 
 'Define index counter
 Dim xdi As Integer
 xdi = 0
 
 ' Loop through the objects in the selection set
 ' and retrieve the xdata for the object
 Dim msgstr As String
 Dim appName As String
 Dim ent As AcadEntity
 appName = "MY_APP"
 For Each ent In sset
 msgstr = ""
 xdi = 0
 
 ' Retrieve the appName xdata type and value
 ent.GetXData appName, xdataType, xdata
 
 ' If the xdataType variable is not initialized, there
 ' was no appName xdata to retrieve for that entity
 If VarType(xdataType) <> vbEmpty Then
 For Each xd In xdata
 msgstr = msgstr & vbCrLf & xdataType(xdi) _
 & ": " & xd
 xdi = xdi + 1
 Next xd
 End If
 
 ' If the msgstr variable is NULL, there was no xdata
 If msgstr = "" Then msgstr = vbCrLf & "NONE"
 MsgBox appName & " xdata on " & ent.ObjectName & _
 ":" & vbCrLf & msgstr
 Next ent
End Sub