Sub AddKeyMark()
Dim obj As AcadObject
Dim pt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity obj, pt, "Выберите примитив: "
If ERR <> 0 Then
ERR.Clear: Exit Sub
End If
Dim key As String
ThisDrawing.Utility.InitializeUserInput 1
key = ThisDrawing.Utility.GetString(False, "Укажите ключ: ")
If ERR <> 0 Then
ERR.Clear: Exit Sub
End If
Dim dict As AcadDictionary
Set dict = ThisDrawing.Dictionaries.Add("NAMED_ENTITIES")
Dim xrec As AcadXRecord
Set xrec = dict.AddXRecord(key)
Dim XRecordDataType As Variant, XRecordData As Variant
Dim ArraySize As Long, iCount As Long
xrec.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
XRecordDataType(ArraySize) = 105: XRecordData(ArraySize) = obj.Handle
xrec.SetXRecordData XRecordDataType, XRecordData
End Sub
Sub CheckKeyMark()
Dim obj As AcadObject
Dim pt As Variant
On Error Resume Next
Dim key As String
ThisDrawing.Utility.InitializeUserInput 1
key = ThisDrawing.Utility.GetString(False, "Укажите ключ: ")
If ERR <> 0 Then
ERR.Clear: Exit Sub
End If
Dim dict As AcadDictionary
Set dict = ThisDrawing.Dictionaries.Add("NAMED_ENTITIES")
Dim xrec As AcadXRecord
Set xrec = dict(key)
If ERR <> 0 Then
ERR.Clear: Exit Sub
End If
Dim XRecordDataType As Variant, XRecordData As Variant
Dim ArraySize As Long, iCount As Long
xrec.GetXRecordData XRecordDataType, XRecordData
If ERR <> 0 Then
ERR.Clear: Exit Sub
End If
If VarType(XRecordDataType) And vbArray = vbArray Then
ArraySize = UBound(XRecordDataType) + 1
For iCount = 0 To ArraySize
If XRecordDataType(iCount) = 105 Then
Dim h As String
h = XRecordData(iCount)
Set obj = ThisDrawing.HandleToObject(h)
Dim ent As AcadEntity
Set ent = obj
ent.Highlight True
key = ThisDrawing.Utility.GetString(False, _
"Подсвечен выбранный примитив. Для продолжения - ENTER")
ent.Highlight False
Exit For
End If
Next
End If
End Sub
