本例提示用户选择图形中的对象，选定的对象将被置于选择集中，并且指定的扩展数据将附着到该选择集中的所有对象
Sub Ch10_AttachXDataToSelectionSetObjects()
' 创建选择集
Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
sset.SelectOnScreen
' 定义扩展数据
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
' 为每个数组定义值
' 1001 指示 appName
xdataType(0) = 1001
xdata(0) = appName
' 1000 指示字符串值
xdataType(1) = 1000
xdata(1) = xdataStr
' 遍历选择集中的所有图元
' 将扩展数据设置和指定给每个图元
Dim ent As Object
For Each ent In sset
ent.SetXData xdataType, xdata
Next ent
End Sub
本例显示上例所附着的扩展数据。如果附着的扩展数据不是字符串（类型 1000）类型，则需要修改此代码
Sub Ch10_ViewXData()
' 查找上例中创建的选择集
Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Item("SS1")
' 定义扩展数据变量以保存扩展数据信息
Dim xdataType As Variant
Dim xdata As Variant
Dim xd As Variant
' 定义索引计数器
Dim xdi As Integer
xdi = 0
' 遍历选择集中的对象
' 并检索对象的扩展数据
Dim msgstr As String
Dim appName As String
Dim ent As AcadEntity
appName = "MY_APP"
For Each ent In sset
msgstr = ""
xdi = 0
' 检索 appName 扩展数据类型和值
ent.GetXData appName, xdataType, xdata
' 如果未初始化 xdataType 变量，
' 则没有可供该图元检索的 appName 扩展数据
If VarType(xdataType) <> vbEmpty Then
For Each xd In xdata
msgstr = msgstr & vbCrLf & xdataType(xdi) _
& ": " & xd
xdi = xdi + 1
Next xd
End If
' 如果 msgstr 变量为 NULL，则没有扩展数据
If msgstr = "" Then msgstr = vbCrLf & "NONE"
MsgBox appName & " xdata on " & ent.ObjectName & _
":" & vbCrLf & msgstr
Next ent
End Sub