Sub Example_SetXRecordData()
    'Этот пример создает новый 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