SetXRecordData Example |
Using Programming Languages other than VBA
Sub Example_SetXRecordData() ' This example creates a new XRecord if one doesn't exist, ' appends data to the XRecord, and reads it back. To see data being added, ' run the example more than once. Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord Dim XRecordDataType As Variant, XRecordData As Variant Dim ArraySize As Long, iCount As Long Dim DataType As Integer, Data As String, msg As String ' Unique identifiers to distinguish our XRecordData from other XRecordData Const TYPE_STRING = 1 Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary" Const TAG_XRECORD_NAME = "ObjectTrackerXRecord" ' Connect to the dictionary in which the XRecord is stored On Error GoTo CREATE Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME) Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME) On Error GoTo 0 ' Get current XRecordData TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ' If there is no array already, create one If VarType(XRecordDataType) And vbArray = vbArray Then ArraySize = UBound(XRecordDataType) + 1 ' Get the size of the data elements returned ArraySize = ArraySize + 1 ' Increase to hold new data ReDim Preserve XRecordDataType(0 To ArraySize) ReDim Preserve XRecordData(0 To ArraySize) Else ArraySize = 0 ReDim XRecordDataType(0 To ArraySize) As Integer ReDim XRecordData(0 To ArraySize) As Variant End If ' Append new XRecord Data ' ' For this sample, we only append the current time to the XRecord XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = CStr(Now) TrackingXRecord.SetXRecordData XRecordDataType, XRecordData ' Read back all XRecordData entries TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ArraySize = UBound(XRecordDataType) ' Retrieve and display stored XRecordData For iCount = 0 To ArraySize ' Get information for this element DataType = XRecordDataType(iCount) Data = XRecordData(iCount) If DataType = TYPE_STRING Then msg = msg & Data & vbCrLf End If Next MsgBox "The data in the XRecord is: " & vbCrLf & vbCrLf & msg, vbInformation Exit Sub
CREATE: ' Create the objects that hold the XRecordData If TrackingDictionary Is Nothing Then ' Make sure the tracking object is there Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME) Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME) End If Resume End Sub
Comments? |