Присвоение объекту символьного идентификатора заданного пользователем.

Автор Тема: Присвоение объекту символьного идентификатора заданного пользователем.  (Прочитано 4942 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Тема содержит сообщение с Решением. Нажмите здесь чтобы посмотреть его.

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Добрый день!
Появилась необходимость обраться к объекту по его идентификатору заданному мной.
Код - Visual Basic [Выбрать]
  1. Set Obj = ThisDrawing.ModelSpace.Item(mark)
Возможно ли присвоить объекту свой идентификатор?
Пример, ссылки, совет преветствуется.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Тут есть два варианта:
1. Воспользоваться XDATA (расширенные данные). Создаёшь RegisteredApplication с нужным тебе именем и добавляешь к своему объекту XDATA с указанным именем. И тогда нужно будет фильтровать по имени расширенного данного.
2. Воспользоваться NOD (Named Object Dictionary - словарь именованных объектов). Тут нужно будет создавать XRecord, в которой присутствует ObjectId нужного тебе примитива.
Первый способ проще для реализации, но если количество объектов, которым "нужно присвоить имя" велико, то чертеж будет замусорен объектами RegisteredApplication. Ну и быстродействие будет не слишком велико, так как при поиске по имени будет просматриваться вся база чертежа.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
В таком виде это сделать нельзя:
Set Obj = ThisDrawing.ModelSpace.Item(mark)
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Отмечено как Решение Vladimir 15-06-2015, 09:39:23

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Вот так (без проверок на ошибки) и с учетом того, что на VBA я совсем не пишу:

Код - Visual Basic [Выбрать]
  1. Sub AddKeyMark()
  2.   Dim obj As AcadObject
  3.   Dim pt As Variant
  4.  
  5.   On Error Resume Next
  6.   ThisDrawing.Utility.GetEntity obj, pt, "Выберите примитив: "
  7.   If ERR <> 0 Then
  8.      ERR.Clear: Exit Sub
  9.   End If
  10.  
  11.   Dim key As String
  12.   ThisDrawing.Utility.InitializeUserInput 1
  13.   key = ThisDrawing.Utility.GetString(False, "Укажите ключ: ")
  14.   If ERR <> 0 Then
  15.      ERR.Clear: Exit Sub
  16.   End If
  17.   Dim dict As AcadDictionary
  18.   Set dict = ThisDrawing.Dictionaries.Add("NAMED_ENTITIES")
  19.   Dim xrec As AcadXRecord
  20.   Set xrec = dict.AddXRecord(key)
  21.   Dim XRecordDataType As Variant, XRecordData As Variant
  22.   Dim ArraySize As Long, iCount As Long
  23.   xrec.GetXRecordData XRecordDataType, XRecordData
  24.   If VarType(XRecordDataType) And vbArray = vbArray Then
  25.        ArraySize = UBound(XRecordDataType) + 1
  26.        ArraySize = ArraySize + 1
  27.        ReDim Preserve XRecordDataType(0 To ArraySize)
  28.        ReDim Preserve XRecordData(0 To ArraySize)
  29.   Else
  30.        ArraySize = 0
  31.        ReDim XRecordDataType(0 To ArraySize) As Integer
  32.        ReDim XRecordData(0 To ArraySize) As Variant
  33.   End If
  34.   XRecordDataType(ArraySize) = 105: XRecordData(ArraySize) = obj.Handle
  35.   xrec.SetXRecordData XRecordDataType, XRecordData
  36. End Sub
  37.  
  38.  
  39. Sub CheckKeyMark()
  40.   Dim obj As AcadObject
  41.   Dim pt As Variant
  42.  
  43.   On Error Resume Next
  44.   Dim key As String
  45.  
  46.   ThisDrawing.Utility.InitializeUserInput 1
  47.   key = ThisDrawing.Utility.GetString(False, "Укажите ключ: ")
  48.   If ERR <> 0 Then
  49.      ERR.Clear: Exit Sub
  50.   End If
  51.   Dim dict As AcadDictionary
  52.   Set dict = ThisDrawing.Dictionaries.Add("NAMED_ENTITIES")
  53.   Dim xrec As AcadXRecord
  54.   Set xrec = dict(key)
  55.   If ERR <> 0 Then
  56.      ERR.Clear: Exit Sub
  57.   End If
  58.   Dim XRecordDataType As Variant, XRecordData As Variant
  59.   Dim ArraySize As Long, iCount As Long
  60.   xrec.GetXRecordData XRecordDataType, XRecordData
  61.   If ERR <> 0 Then
  62.      ERR.Clear: Exit Sub
  63.   End If
  64.   If VarType(XRecordDataType) And vbArray = vbArray Then
  65.        ArraySize = UBound(XRecordDataType) + 1
  66.        For iCount = 0 To ArraySize
  67.          If XRecordDataType(iCount) = 105 Then
  68.            Dim h As String
  69.            h = XRecordData(iCount)
  70.            Set obj = ThisDrawing.HandleToObject(h)
  71.            Dim ent As AcadEntity
  72.            Set ent = obj
  73.            ent.Highlight True
  74.            key = ThisDrawing.Utility.GetString(False, _
  75.               "Подсвечен выбранный примитив. Для продолжения -  ENTER")
  76.            ent.Highlight False
  77.            Exit For
  78.          End If
  79.        Next
  80.   End If
  81. End Sub

Первая функция добавляем примитиву "имя" (ключ). Вторая по "имени" находит примитив и подсвечивает его.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Ок, спасибо.
Завтра попробую и отпишусь....

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Добрый день!
Все работает, спасибо.
Прикручиваю к проекту...