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