GetXRecordData Example

Using Programming Languages other than VBA

Sub Example_GetXRecordData()
	' 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 we store the XRecord in
	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 we don't have an array already then 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 entities that hold our XRecordData
	If TrackingDictionary Is Nothing Then  ' Make sure we have our tracking object
		Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)
		Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)
	End If

	Resume
End Sub





   Comments?