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?