Sub Example_TranslateIDs()
    'Этот пример создает новый XRecord и переключает установку для TranslateIDs
    
    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
    
    'Если мы не имеем массива, cоздаем его
    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
    
    'Найдите текущее значение TranslateIDs
    Dim currXlate As Boolean
    currXlate = TrackingXRecord.TranslateIDs
    MsgBox "Текущая установка TranslateIDs " & currXlate
    
    'Переключите установку
    TrackingXRecord.TranslateIDs = Not currXlate
    MsgBox "Новая установка для TranslateIDs " & TrackingXRecord.TranslateIDs
    
    'Сбросьте значение
    TrackingXRecord.TranslateIDs = currXlate
    MsgBox "TranslateIDs был сброшен к " & TrackingXRecord.TranslateIDs
    
    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