GetXData and SetXData method example

Option Explicit

Private Const APP_NAME As String = "TEST_APP"

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

' info in the debug window.

Sub ReadXData()

     ' get the entity.

     Dim anObj As Object

     Dim pt As IntelliCAD.Point

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

     ' get its xdata.

     Dim xdataType As Variant

     Dim xdataValue As Variant

     Dim appName 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)

          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 IntelliCAD.Point

                    Set ptX = xdataValue(i)

                    Debug.Print "XData Type: " & xdataType(i) & " Xdata Value: " & ptX.x & "," & ptX.y & "," & ptX.z

                    Set ptX = Nothing

               Else

                    Debug.Print "XData Type: " & xdataType(i) & " Xdata Value: " & xdataValue(i)

               End If

          Next i

     Else

          Debug.Print "No XData for " & APP_NAME

     End If

     

     Set anObj = Nothing

End Sub

Sub AppendXData()

     ' get the entity.

     Dim anObj As Object

     Dim pt As IntelliCAD.Point

     ActiveDocument.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