Assign and Retrieve Extended Data

You can use extended data (xdata) as a means for linking information with objects in a drawing.

Assign xdata to all objects in a selection set

This example prompts the user to select objects from the drawing. The selected objects are placed into a selection set, and the specified xdata is attached to all objects in that selection set

Sub Ch10_AttachXDataToSelectionSetObjects()
	' Create the selection set
	Dim sset As Object
	Set sset = ThisDrawing.SelectionSets.Add("SS1")

	' Prompt the user to select objects

	' 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

View the xdata of all objects in a selection set

This example displays the xdata attached with the previous example. If you attach xdata other than strings (type 1000), you will need to revise this code

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