Sub Example_GetXRecordData()
    ' Этот пример создает новый XRecord, добавляет в конец данные XRecord и читает их.
    
    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
    
    ' Уникальные идентификаторы, чтобы отличить нашего XRecordData от другого XRecordData
    Const TYPE_STRING = 1
    Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"
    Const TAG_XRECORD_NAME = "ObjectTrackerXRecord"

    ' Соединитесь со словарем, в котором мы сохраняем XRecord
    On Error GoTo CREATE
    Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
    Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)
    On Error GoTo 0
    
    ' Получите текущий XRecordData
    TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
    
    ' Если мы не имеем массива, тогда создём его
    If VarType(XRecordDataType) And vbArray = vbArray Then
        ArraySize = UBound(XRecordDataType) + 1       ' Получите размер возвращенных элементов данных
        ArraySize = ArraySize + 1                        ' Увеличение, чтобы держать новые данные
    
        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
    
    ' Добавьте в конец новые Данные XRecord
    '
    ' Для этой выборки мы только добавляем в конец текущее время XRecord
    XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = CStr(Now)
    TrackingXRecord.SetXRecordData XRecordDataType, XRecordData
    
    ' Читайте назад все входы XRecordData
    TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
    ArraySize = UBound(XRecordDataType)
    
    ' Получите и покажите сохранённые XRecordData
    For iCount = 0 To ArraySize
        ' Получите информацию для этого элемента
        DataType = XRecordDataType(iCount)
        Data = XRecordData(iCount)
        
        If DataType = TYPE_STRING Then
            msg = msg & Data & vbCrLf
        End If
    Next
    
    MsgBox "Данные в XRecord: " & vbCrLf & vbCrLf & msg, vbInformation
    
    Exit Sub

CREATE:
    ' Создайте объекты, которые держат нашего XRecordData
    If TrackingDictionary Is Nothing Then  ' Удостоверьтесь, что мы имеем наш объект отслеживания
        Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)
        Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)
    End If
    
    Resume
End Sub

Сайт управляется системой uCoz