du kannst dir auch ein Dictionary anlegen und in diesem die Daten z.B: in einem XRECORD speichern... geht aber auch alles per Lisp ( genauso wie XDATA) für Dictionaries und Xrecord findest du ein Beispiel in der Onlinehilfe..:
Sub Example_AddXRecord()
' This example creates a new XRecord if one doesn't 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
------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de
| 
