Asignación y recuperación de datos extendidos

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
    

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