Creates an XRecord object in any dictionary.
Supported platforms: Windows only
VBA:
RetVal = object.AddXRecord(Keyword)
Type: Dictionary
The object this method applies to.
Access: Input-only
Type: String
The name of the XRecord within the dictionary.
No additional remarks.
VBA:
Sub Example_AddXRecord() ' This example creates a new XRecord if one does not exist, ' appends data to the XRecord, and then 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 this XRecordData from other XRecordData Const TYPE_STRING = 1 Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary" Const TAG_XRECORD_NAME = "ObjectTrackerXRecord" ' Connect to the dictionary in which to store the XRecord 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 yet 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 objects that hold this XRecordData If TrackingDictionary Is Nothing Then ' Make sure to have tracking object Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME) Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME) End If Resume End Sub
Visual LISP:
(vl-load-com) (defun c:Example_AddXRecord() ;; This example creates a new XRecord if one does not exist, ;; appends data to the XRecord, and then reads it back. To see data being added, ;; run the example more than once. (setq acadObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument acadObj)) ;; Unique identifiers to distinguish this XRecordData from other XRecordData (setq TYPE_STRING 1 TAG_DICTIONARY_NAME "ObjectTrackerDictionary" TAG_XRECORD_NAME "ObjectTrackerXRecord") ;; Connect to the dictionary in which to store the XRecord (setq dictionaries (vla-get-Dictionaries doc)) (setq TrackingDictionary (vl-catch-all-apply 'vla-Item (list dictionaries TAG_DICTIONARY_NAME))) ;; (= (vl-catch-all-error-message TrackingDictionary) "Automation Error. Key not found") (if (= (type TrackingDictionary) 'VLA-OBJECT) (setq TrackingXRecord (vla-GetObject TrackingDictionary TAG_XRECORD_NAME)) (progn ;; Create the objects that hold this XRecordData (setq TrackingDictionary (vla-Add dictionaries TAG_DICTIONARY_NAME)) (setq TrackingXRecord (vla-AddXRecord TrackingDictionary TAG_XRECORD_NAME)) ) ) ;; Get current XRecordData (vla-GetXRecordData TrackingXRecord 'temp-XRecordDataType 'temp-XRecordData) ;; If there is no array yet then create one (setq ArraySize 0) (if (/= temp-XRecordDataType nil) (progn (setq ArraySize (vlax-safearray-get-u-bound temp-XRecordDataType 1)) (setq XRecordDataType (vlax-make-safearray vlax-vbInteger (cons 0 (1+ ArraySize)))) (setq XRecordData (vlax-make-safearray vlax-vbVariant (cons 0 (1+ ArraySize)))) (setq iCount 0) (while (>= ArraySize iCount) ;; Get information for this element (setq DataType (vlax-safearray-get-element temp-XRecordDataType iCount)) (setq Data (vlax-variant-value (vlax-safearray-get-element temp-XRecordData iCount))) (vlax-safearray-put-element XRecordDataType iCount DataType) (vlax-safearray-put-element XRecordData iCount Data) (setq iCount (1+ iCount)) ) ) (progn (setq XRecordDataType (vlax-make-safearray vlax-vbInteger '(0 . 0))) (setq XRecordData (vlax-make-safearray vlax-vbVariant '(0 . 0))) ) ) ;; Append new XRecord Data ;; ;; For this sample we only append the current time to the XRecord (vlax-safearray-put-element XRecordDataType ArraySize TYPE_STRING) (setq cdate (rtos (vlax-variant-value (vla-GetVariable doc "CDATE")) 2 6)) (vlax-safearray-put-element XRecordData ArraySize (strcat (substr cdate 5 2) "/" (substr cdate 7 2) "/" (substr cdate 1 4) "-" (substr cdate 10 2) ":" (substr cdate 12 2) ":" (substr cdate 14))) (vla-SetXRecordData TrackingXRecord XRecordDataType XRecordData) ;; Read back all XRecordData entries (vla-GetXRecordData TrackingXRecord XRecordDataType XRecordData) (setq ArraySize (vlax-safearray-get-u-bound XRecordDataType 1)) ;; Retrieve and display stored XRecordData (setq iCount 0 msg "") (while (>= ArraySize iCount) ;; Get information for this element (setq DataType (vlax-safearray-get-element XRecordDataType iCount)) (setq Data (vlax-variant-value (vlax-safearray-get-element XRecordData iCount))) (if (= DataType TYPE_STRING) (setq msg (strcat msg Data "\n")) ) (setq iCount (1+ iCount)) ) (alert (strcat "The data in the XRecord is: \n\n" msg)) )