GetXData and SetXData method example

Sub GetXData_Example()

' This example gets an entity and its Xdata (if it exists) and

' prints the info in msgbox

    Const APP_NAME As String = "TEST_APP"

    Dim anObj As Object

    Dim pt(0 To 2) As Double

    ' get the entity.

    ThisDrawing.Utility.GetEntity anObj, pt, "Select an entity: "

    ' get its xdata.

    Dim xdataType As Variant

    Dim xdataValue As Variant

    Dim appName As String

    Dim sBuf As String

    anObj.GetXData APP_NAME, xdataType, xdataValue

    ' iterate through the XData.

    Dim lbnd As Integer, ubnd As Integer

    Dim i As Integer

    If (vbEmpty <> VarType(xdataType)) Then

        lbnd = LBound(xdataType)

        ubnd = UBound(xdataType)

        sBuf = "Xdata for app " & APP_NAME

        For i = lbnd To ubnd

            If 1010 = xdataType(i) Or 1011 = xdataType(i) Or 1012 = xdataType(i) Or 1013 = xdataType(i) Then

                Dim ptX As Variant

                ptX = xdataValue(i)

                sBuf = sBuf & vbCrLf & "XData Type: " & xdataType(i) & " Xdata Value: " & ptX(0) & "," & ptX(1) & "," & ptX(2)

            Else

                sBuf = sBuf & vbCrLf & "XData Type: " & xdataType(i) & " Xdata Value: " & xdataValue(i)

            End If

        Next i

    Else

        sBuf = "No XData for application " & APP_NAME

    End If

    MsgBox sBuf

    Set anObj = Nothing

End Sub

Sub SetXData_Example()

' This example gets an entity and adds Xdata to it

    Const APP_NAME As String = "TEST_APP"

    Dim anObj As Object

    Dim pt(0 To 2) As Double

    ' get the entity.

    ThisDrawing.Utility.GetEntity anObj, pt, "Select an entity: "

    ' get its xdata.

    Dim xdataType As Variant

    Dim xdataValue As Variant

    anObj.GetXData APP_NAME, xdataType, xdataValue

    If (vbEmpty = VarType(xdataType)) Then

        Dim tmp(0 To 0) As Integer

        xdataType = tmp

        ReDim xdataValue(0 To 0)

        ' the first item in the XData should be a 1001

        ' code giving the app's name.

        xdataType(0) = 1001

        xdataValue(0) = APP_NAME

    End If

    ' redimension the XData arrays, preserving their

    ' contents.

    ReDim Preserve xdataType(LBound(xdataType) To UBound(xdataType) + 1)

    ReDim Preserve xdataValue(LBound(xdataValue) To UBound(xdataValue) + 1)

    ' stuff some new data in.

    xdataType(UBound(xdataType)) = 1000

    xdataValue(UBound(xdataValue)) = "Hi, I was added!"

    ' store the data.

    anObj.SetXData xdataType, xdataValue

    Set anObj = Nothing

End Sub