Программирование на VBA

Размерности в пространстве модели и пространстве лист

Рисовать размерности можно как в пространстве модели, так и в пространстве листа, однако если фигуры в пространстве модели, то и размеры лучьше рисовать там же. Если же рисовать размер в пространстве листа, когда фигуры нарисованы в пространстве модели, то они не меняются автоматически, когда вы используете команды редактирования и увеличения. Если вы проставляете размеры в пространстве листа, и глобальный фактор масштабирования DIMLFAC для линейных размеров меньше нуля, измеренное расстояние умножается на абсолютное значение DIMLFAC. Если размеры в пространстве модели, то используется значение 1.0, даже если DIMLFAC меньше нуля.

Создание указателей и примечаний

Указатель - это линия соединяющая примечание с какой-либо частью рисунка. указатель связан с примечанием и меняется вместе с ним, если примечание отредактировать. Не путайте объект указатель с линией-указателем автоматически создаваемой AutoCADом как часть размерной линии. Указатель может быть в форме прямого сегмента или кривой. Цвет его зависит от цвета текущих размерных линий. Масштаб его управляется общим масштабом размерностей, установленном в активном размерном стиле. Тип и размер стрелок, если они есть, управляется первой стрелкой определенной в активном размерном стиле. Малая линия, известная как крючок, обычно присоединена к примечанию, если у указателя нет примечания, то нет и крючка. Для создания указателя используется метод AddLeader, принимающий три параметра: массив координат в форме переменной типа Variant, собственно примечание, и тип определяющий форму - прямой или кривая, а так же есть у него стрелка или нет. Следующие константы определяют тип указателя: acLineNoArrow, acLineWithArrow, acSplineNoArrow, acSplineWithArrow.

Sub CreateLeader()
  Dim leaderObj As AcadLeader
  Dim points(0 To 8) As Double
  Dim leaderType As Integer
  Dim annotationObject As AcadObject
  
  points(0) = 0: points(1) = 0: points(2) = 0
  points(3) = 4: points(4) = 4: points(5) = 0
  points(6) = 4: points(7) = 5: points(8) = 0
  leaderType = acLineWithArrow
  Set annotationObject = Nothing
      
  Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotationObject, leaderType)
  ZoomExtents
End Sub

Добавление примечания к указателю

Примечание может быть в виде объектов Tolerance, MText, BlockRef и присоединяется к указателю только при его создании.

Ассациативность указателей

Примечание связывается с соответствующим указателем и при перемещении примечания конечная точка указателя перемещается с ним. Уничтожение обоих объектов методами Erase, Add (для блоков) и WBlock. При копировании примечания и указателя одной командой они становятся ассациативными в любом случае. Если ассациативность разрывается по любой причине, например если копируется отдельно указатель или удаляется примечание, то крючок тоже удаляется.

Sub AddAnnotation()
  Dim leaderObj As AcadLeader
  Dim mtextObj As AcadMText
  Dim points(0 To 8) As Double
  Dim insPoint(0 To 2) As Double
  Dim width As Double
  Dim leaderType As Integer
  Dim annotObj As Object
  Dim textString As String, msg As String
  
  textString = "Hello, World."
  insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0: width = 2
  Set mtextObj = ThisDrawing.ModelSpace.AddMText(insPoint, width, textString)
  ' данные для указателя
  points(0) = 0: points(1) = 0: points(2) = 0
  points(3) = 4: points(4) = 4: points(5) = 0
  points(6) = 4: points(7) = 5: points(8) = 0
  leaderType = acLineWithArrow
     
  ' Создаем указатель и связываем с ним объект MText
  Set annotObj = mtextObj
  Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotObj, leaderType)
  ZoomExtents
End Sub

Редактирования ассациативности указателя

Исключая случая ассациативности указатель и его примечание являются отдельными объектами. Хотя текстовые примечания создаются с использованием системных переменных DIMCLRT, DIMTXT, DIMTXSTY определяющих их цвет, высоту и стиль они не могут быть изменены через эти переменные, т.к. на самом деле не являются объектами Размеры. Редактировать их следует теми же методами, что и обычный мультитекст. Метод Evalute обновляет размеры указателя при изменении примечания, если это необходимо.

Редактирование указателей

Любые изменения примечаний приводят к изменению конечной точки указателя. Для измения размера указателя его можно масштабировать, при этом размеры примечания остаются без изменения. Можно так же перемещать, вращать и зеркально отражать указатель.

Создание геометрических допусков

Геометрические допуски показвают возможные отклонения форм, профилей и т.д. Для их создания есть метод AddTolerance, требующий три параметра - текстовая строка, расположение и направляющий вектор. Можно так же копировать, стирать, вращать, масштабировать допуски. Пример создания:

Sub CreateTolerance()
  Dim toleranceObj As AcadTolerance
  Dim textString As String
  Dim insPoint(0 To 2) As Double
  Dim direction(0 To 2) As Double
  
  ' Define the tolerance object
  textString = "Here is the Feature Control Frame"
  insPoint(0) = 5: insPoint(1) = 5: insPoint(2) = 0
  direction(0) = 1: direction(1) = 1: direction(2) = 0
  ' Create the tolerance object in model space
  Set toleranceObj = ThisDrawing.ModelSpace.AddTolerance(textString, insPoint, direction)
  ZoomExtents
End Sub

Редактирование допусков

Допуски подвержены влиянию нескольких системных переменных: DIMCLRD, DIMCLRT, DIMGAP, DIMTXT, DIMTXTSTY

Настройка меню и панелей инструментов

Две наиболее важных коллекции, касающиеся меню MenuBar, MenuGroups. Первая содержит все отображаемые меню, вторая группы меню, часть из которых может не отражаться на экране. Группы меню могут содержать панели инструментов.

Исследование коллекции menugroups

Каждая группа меню содержит коллекции PopupMenus и Toolbars. Схема такова MenuBar-PopupMenu.MenuGroups-MenuGroup.В составе MenuGroup - PopupMenus и Toolbars.PopupMenus-PopupMenu-PopupMenuItem, Toolbars-Toolbar-ToolbarItem.

Загрузка групп меню

Выполняется методом Load, если параметр BaseMenu установлен =True, загружается новая группа меню, как основное меню аналогично команде MENU. Если этот параметр не указать, то загружается частичное меню, аналогично тому как это делает команда MENULOAD. Сразу после загрузки частичное меню может быть вставлено в панель меню методом InsertMenuInMenuBar или InsertInMenuBar. Так же становятся доступны все меню и панели инструментов входящие в меню. Далее можно;

• добавлять меню к панели меню;
• удалять меню из панели;
• переупорядочивать;
• добавлять новый пункт в меню или панель инструментов;
• удалять пункт из меню или панели инструментов;
• создавать меню и панель инструментов;
• делать меню плавающим или пристыкованным;
• делать доступным и недоступным пункт меню и панели инструментов;
• делать выбранным или неактивным;
• менять название, тэг и строку подсказки;
• переназначать связанный макрос.

Пример загрузки группы меню:

ThisDrawing.Application.MenuGroups.Load "acad.mnc" 

Создание новой группы меню

AutoCAD ActiveX не позволяет создавать пустую группу меню, однако можно загрузить существующую и сохранить с новым именем и в новом файле. После чего его можно отредактировать по своему желанию. Приимущество данного подхода в том, что оказываются уже созданными базовые меню Файл, Окно и Помощь. Пример сохранения группы меню в новом файле:

ThisDrawing.Application.MenuGroups.Item(0).SaveAs "MyMenu.mnc", acMenuFileCompiled 

Изменение панели меню

Основное меню может быть полностью замещено загружаемым, если оно загружается как основное меню. Кроме того могут быть модифицированы и отдельные меню. Оба метода InsertMenuInMenuBar и InsertInMenuBar преследуют одну цель. Различие между ними в объекте из которого они вызываются. Первый вызывается из коллекции PopupMenus, требует имя меню и точку вставки. Второй вызывается непосредственно из объекта PopupMenu и требует только указания точки вставки. Вам решать какой метод избрать. Пример вставки меню:

Sub InsertMenu()
  ' Определим переменную для группы меню
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  ' Создадим меню
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")

  ' Определим переменную для пункта меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String

  ' Назначим макрос аналог "ESC ESC _open " и создадим пункт меню
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = newMenu.AddMenuItem(newMenu.Count + 1, "Open", openMacro)

  ' Отобразим меню
  currMenuGroup.Menus.InsertMenuInMenuBar "TestMenu", ""
End Sub

Удаление меню из панели меню

Для данной цели используйте один из следующих методов RemoveMenuFromMenuBar или RemoveFromMenuBar. Различия между ними те же что и для вышеописанных методов добавления меню. Пример удаления: currMenuGroup.Menus.RemoveMenuFromMenuBar ("TestMenu") В результате меню становятся невидимым, но физически не удаляется. Пример переупорядочивания меню (первый пункт переносится в конец):

Sub MoveMenu()
  ' Определим переменную содержащую меню
  Dim moveMenu As AcadPopupMenu
  Dim MyMenuBar As AcadMenuBar
  Set MyMenuBar = ThisDrawing.Application.menuBar

  ' установим moveMenu равным первому
  Set moveMenu = MyMenuBar.Item(0)

  ' уберем с первой позиции
  MyMenuBar.Item(0).RemoveFromMenuBar

  ' вставим в последнюю
  moveMenu.InsertInMenuBar (MyMenuBar.count)
End Sub

В результате меню File должно переехать в последнюю позицию.

Создание и редактирование выпадающих и всплывающих меню

Оба типа меню отображаются как каскадные меню. Последние, например, позволяют включать-включать объектную привязку. Выпадающие меню могут содержать до 999 пунктов. А всплывающие только до 499. Оба предела включют все меню в иерархии. Если меню не умещается на экране, то оно грубо обрезается. Всплывающие меню появляются обычно рядом с перекрестием. Если свойство ShortcutMenu=TRUE значит, это оно и есть.

Cоздание меню

Методом Add можно добавить объект PopupMenu в коллекцию PopupMenus. Для создания нового всплывающего старое следует сначала удалить. Может быть только одно такое меню на группу. Если таких меню нет, то можно создать его с именем "POP0". После чего по этому имени можно обращаться к меню в коллекции. Меню может включать и некторые специальные символы. Пример создания выпадающего меню:

Sub CreateMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")
End Sub

Добавление пункта к меню

Метод AddMenuItem добавляет пункт в выпадающее меню, принимает четыре параметра - Index, Label, Tag, Macro. Index начинается с нуля, для добавления в конец установи индекс = значению свойства Count. Label - строка, определяющая содержание и формат пункта меню. (может содержать DEISEL выражение и специальные коды). Текст пункта меню еще называют Caption. Тэг - строка символов, включая подчеркивание идентифицирующая пункт меню. Макро - набор команд, выполняющихся при выборе пункта меню. Может быть как простым макросом вызывающим команду так и сложным набором команд. Пример добавления пункта меню:

Sub AddAMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")

  ' добавим пункт
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  ' назначим макрос эквивалентный "ESC ESC _open "
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)

  Set newMenuItem = newMenu.AddMenuItem(newMenu.count + 1, "Open", openMacro)

  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub

Для добавления разделителя между пунктами меню используйте метод AddSeparator.

Доступ к горячим клавишам

Для назначения горячей клавиши используйте символ & непосредственно перед буквой, которая и будет горячей. Пример:

Sub AddAMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("Te" + Chr(Asc("&")) + "stMenu")

  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = newMenu.AddMenuItem(newMenu.count + 1, Chr(Asc("&")) _
      + "Open", openMacro)

  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub

Создание каскадных подменю

Для этой цели используйте метод AddSubmenu который создает новый объект PopupMenu и добавляет его в меню. Принимает три параметра - Index, Label и Tag. Данный метод не возвращает объект PopupMenu вместо этого он возвращает новое меню на которое указывает подменю, это меню следует добавить в существующее. Пример:

Sub AddASubMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")

  ' Добавим подменю
  Dim FileSubMenu As AcadPopupMenu
  Set FileSubMenu = newMenu.AddSubMenu("", "OpenFile")

  ' Добавим пункт в подменю
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = FileSubMenu.AddMenuItem(newMenu.count + 1, "Open", openMacro)

  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub

Удаление пункта из меню

Sub DeleteMenuItem()
  Dim LastMenu As AcadPopupMenu
  Set LastMenu = ThisDrawing.Application.menuBar. _
              Item(ThisDrawing.Application.menuBar.count - 1)

  ' Добавим пункт меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newMenuItem = LastMenu.AddMenuItem(LastMenu.count + 1, "Open", openMacro)

  ' Удалим пункт меню
  newMenuItem.Delete
End Sub

Исследование свойств пункта меню

Все пункты меню разделяют следующие свойства:

• Tag - уникальный идентификатор,
• Label - строка, определяющая содержание и форматирование,
• Caption - тот текст пункта меню, который видит пользователь,
• Macro - простой макрос или набор команд,
• Help String - быстрая подсказка в строке состояния,
• Enable - доступно или нет для выбора,
• Check - выбрано или нет, Index - номер пункта, начиная с нуля,
• Type - acMenuItem или acMenuSeparator или acSubMenu,
• Parent - меню к которому принадлежид данное меню. Пример включение/ отключения доступности:

Sub DisableMenuItem()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  Dim newMenu As AcadPopupMenu
  Set newMenu = currMenuGroup.Menus.Add("TestMenu")

  ' Добавим два пункта и разделитель
  Dim MenuEnable As AcadPopupMenuItem
  Dim MenuDisable As AcadPopupMenuItem
  Dim MenuSeparator As AcadPopupMenuItem
  Dim openMacro As String

  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set MenuEnable = newMenu.AddMenuItem(newMenu.count + 1, "OpenEnabled", openMacro)
  Set MenuSeparator = newMenu.AddSeparator("")
  Set MenuDisable = newMenu.AddMenuItem(newMenu.count + 1, "OpenDisabled", openMacro)

  ' Запретим второй пункт
  MenuDisable.Enable = False

  ' Отобразим
  newMenu.InsertInMenuBar(ThisDrawing.Application.menuBar.count + 1)
End Sub

Создание и редактирование панелей инструментов

Добавить кнопку на панель можно методом AddToolbarButton который принимает 5 параметров: Index, Name, HelpString, Macro, FlyoutButton (определяет будет ли панель выпадающая). Пример:

Sub AddButton()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  ' Создаем сначала панель
  Dim newToolbar As AcadToolbar
  Set 

newToolbar = currMenuGroup.Toolbars.Add("TestToolbar")

  ' Добавляем кнопку
  Dim newButton As AcadToolbarItem
  Dim openMacro As String

  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newButton = newToolbar.AddToolbarButton("", "NewButton", "Open a file.", openMacro)
End Sub

Добавление разделителя - использовать метод AddSeparator.

Назначение значка для кнопки

Для этого есть методы SetBitmap и GetBitmap, первый принимает два параметра SmallIconName (bmp-файл 15х16) и LargeIconName (bmp-файл 24х22). Пример опроса существующей панели на предмет наличия иконок у кнопок.

Sub GetButtonImages()
  Dim Button As AcadToolbarItem
  Dim Toolbar0 As AcadToolbar
  Dim MenuGroup0 As AcadMenuGroup
  Dim SmallButtonName As String,LargeButtonName As String
  Dim msg As String
  Dim ButtonType As String

  ' Первая панель в первой группе меню
  Set MenuGroup0 = ThisDrawing.Application.MenuGroups.Item(0)
  Set Toolbar0 = MenuGroup0.Toolbars.Item(0)

  SmallButtonName = "": LargeButtonName = ""

  msg = "Панель: " + Toolbar0.Name + vbCrLf
  Toolbar0.Visible = True

  ' Пройдем по коллекции, отображая имена иконок кнопок
  For Each Button In Toolbar0
      ButtonType = Choose(Button.Type + 1, "Button", "Separator", "Control", "Flyout")
      msg = msg & ButtonType & ":   "
      If Button.Type = acToolbarButton Or Button.Type = acToolbarFlyout Then
          Button.GetBitmaps SmallButtonName, LargeButtonName
          msg = msg + SmallButtonName + ", " + LargeButtonName
      End If
      msg = msg + vbCrLf
  Next Button

  MsgBox msg
End Sub

Создание выпадающей панели

Sub AddFlyoutButton()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  ' Создадим панель
  Dim FirstToolbar As AcadToolbar
  Set FirstToolbar = currMenuGroup.Toolbars.Add("FirstToolbar")
  ' Добавим кнопку для выпадающей панели
  Dim FlyoutButton As AcadToolbarItem
  Set FlyoutButton = FirstToolbar.AddToolbarButton _
          ("", "Flyout", "Пример выпадающей панели","OPEN", True)

  ' Создадим вторую панель и привяжем ее к кнопе первой панели
  Dim SecondToolbar As AcadToolbar
  Set SecondToolbar = currMenuGroup.Toolbars.Add("SecondToolbar")

  ' Добавим кнопку на вторую панель
  Dim newButton As AcadToolbarItem
  Dim openMacro As String

  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  Set newButton = SecondToolbar.AddToolbarButton _
          ("", "NewButton", "Open a file.", openMacro)

  ' Присоединим вторую панель к кнопке первой
  FlyoutButton.AttachToolbarToFlyout currMenuGroup.Name,SecondToolbar.Name

  ' Отобразим первую панель, скрыв вторую
  FirstToolbar.Visible = True
  SecondToolbar.Visible = False
End Sub

Плавающая и пристыкованная панели

Чтобы сделать панель плавающей следует использовать метод Float, принимающий три параметра: top, left и NumberFloatRows. Для создания пристыкованной панели используйте метод Dock, принимающий три параметра: Side, Row, Column. Пример создания такой панели:

Sub DockToolbar()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

  ' Создадим панель
  Dim newToolbar As AcadToolbar
  Set newToolbar = currMenuGroup.Toolbars.Add("TestToolbar")

  ' Добавим кнопки с одним и тем же макросом для простоты
  Dim newButton1 As AcadToolbarItem
  Dim newButton2 As AcadToolbarItem
  Dim newButton3 As AcadToolbarItem
  Dim openMacro As String

  ' Назначим макрос
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)

  Set newButton1 = newToolbar.AddToolbarButton("", "NewButton1", "Open a file.", openMacro)
  Set newButton2 = newToolbar.AddToolbarButton("", "NewButton2", "Open a file.", openMacro)
  Set newButton3 = newToolbar.AddToolbarButton("", "NewButton3", "Open a file.", openMacro)

  ' Отобразим панель
  newToolbar.Visible = True

  ' Пристыкуем к левому краю экрана
  newToolbar.Dock acToolbarDockLeft
End Sub

Для удаления кнопки из панели используется метод Remove когда панель инструментов видима.

Свойства элементов панели инструментов

Tag, Name, Macro, HelpString, Index, Type (acButton, acToolButtonSeparator, acControl), Flyout, Parent, и другие - задающие пристыковку, видимость и т.д.

Создание макросов

Макросы представляют собой серию команд, выполняющих определенные действия. Если команда, вызываемая макросом, принимает параметры, то нужно знать в какой последовательности. Каждый символ имеет значение - и даже пробел. Последовательность параметров может меняться от версии к версии AutoCAD. Когда команда вводится из пункта меню, значения системных переменных PICKADD и PICKAUTO равны 1 и 0 соответственно для совместимости с предыдущими версиями AutoCAD.

Таблица соответствия комбинация клавиш ascii-символам

При выполнении макросов AutoCAD помещает пробел в конец, перед выполнением последовательности команд. Когда это не желательно (например, для команд TEXT или DIM) команда может завершаться Enter, а не пробелом. Также иногда требуется более одного пробела или Enter, но некторые текстовые редакторы не позволяют создавать строки с концевыми пробелами. Для избежания этой проблемы используются два специальных соглашения:

• когда в макросе встречается точка с запятой AutoCAD заменяет ее на Enter,
• если строка заканчивается управляющим символом (обратный слэш, плюс или точкаСзапятой) AutoCAD не добавляет пробел.

Обратный слэш вызывает ввод параметров команды пользователем, и обычно после ввода одного параметра продолжается выполнение макроса. Значит невозможно создать макрос, принимающий переменное число параметров и продолжающего выполнение (как например при выборе объектов). Одно исключение сделано для команды SELECT. Например следующий макрос

select \change previous ;properties color red ;

позволяет выбрать несколько объектов, затем вызывается команда Change с опцией Previos и меняется цвет у выбранных объектов. Так как обратный слэш используется для ожидания ввода, его нельзя использовать для других действий. Поэтому при указании пути к файлу в качестве разделителя используется прямой слэш. Следующие обстоятельства задерживают выполнение макроса:

• если ожидается ввод точки режим объектной привязки может предварять ввод актуального значения;
• если используется фильтр XYZ макрос приостанавливается до тех пор, пока не будет накоплена точка;
• если вызывается команда SELECT;
• если пользователь вводит прозрачную команду;
• если пользователь запускает другой макрос.

Перед началом выполнения макроса рекомендуется использовать последовательность ^C^C, чтобы отменить выполнение предыдущей команды. Для выполнения макроса в цикле используется *^C^C (при этом в самом макросе уже нельзя использовать ^C, т.к. это приведет к его прерыванию). Пример: *^C^CMOVE Single.

Добавление пунктов во всплывающее меню

Такие меню появляются когда пользователь нажимает правую кнопку мыши, удерживая при этом Shift. AutoCAD ищет высплывающее меню в группе меню по установленному значению свойства ShortcutMenu=TRUE. Добавление пункта во всплывающее меню

Sub AddMenuItemToshortcutMenu()
  Dim currMenuGroup As AcadMenuGroup
  Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
  
  ' ищем всплывающее меню и назначаем ему переменную
  Dim scMenu As AcadPopupMenu
  Dim entry As AcadPopupMenu
  For Each entry In currMenuGroup.Menus
      If entry.shortcutMenu = True Then
          Set scMenu = entry
      End If
  Next entry
      
  ' добавим новый пункт меню
  Dim newMenuItem As AcadPopupMenuItem
  Dim openMacro As String
  openMacro = Chr(3) + Chr(3) + Chr(95) + "open" + Chr(32)
  
  Set newMenuItem = scMenu.AddMenuItem ("", Chr(Asc("&")) + "OpenDWG", openMacro)
End Sub