指定和检索扩展数据

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
    

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