Что не стоит программно делать с меню
Естественно, разговор о лиспе 
Допустим, нам надо после загрузки нашего частичного меню слегка модифицировать команды. Имею в виду команды из выпадающего меню и из палитр инструментов.
Так вот, добраться до нужной команды не так уж и сложно:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | (vl-load-com) (setq *kpblc-acad* (vlax-get-acad-object)) (defun _kpblc-menu-get-all-elements (group-name) ;| * Выводит перечень всех элементов меню, в том числе и вложенных, как перечень vla-указателей. * Параметры вызова: group-name строка с именем группы меню в ACAD, либо vla-указатель на родителя * Примеры вызова: (_kpblc-menu-get-all-elements "test-menu") |; (cond ((and (= (type group-name) 'str) (= (type (setq group-name (vl-catch-all-apply (function (lambda () (vla-item (vla-get-menugroups *kpblc-acad*) group-name))))) ) ;_ end of type 'vla-object ) ;_ end of = ) ;_ end of and (_kpblc-menu-get-all-elements group-name) ) ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'menus)) (apply (function append) (mapcar (function _kpblc-menu-get-all-elements) (_kpblc-conv-vla-to-list (vla-get-menus group-name)) ) ;_ end of mapcar ) ;_ end of apply ) ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'submenu) (vlax-property-available-p group-name 'type) (= (vla-get-type group-name) acmenusubmenu) ) ;_ end of and (apply (function append) (mapcar (function _kpblc-menu-get-all-elements) (_kpblc-conv-vla-to-list (vla-get-submenu group-name)) ) ;_ end of mapcar ) ;_ end of apply ) ((and (= (type group-name) 'vla-object) (not (vlax-property-available-p group-name 'type))) (apply (function append) (mapcar (function _kpblc-menu-get-all-elements) (_kpblc-conv-vla-to-list group-name)) ) ;_ end of apply ) ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'type) (= (vla-get-type group-name) acmenuitem) ) ;_ end of and (list group-name) ) ) ;_ end of cond ) ;_ end of defun (defun _kpblc-conv-vla-to-list (value / res) ;| * Преобразовывает vla-, vlax-variant или vlax-safearray в список. |; (cond ((listp value) (mapcar (function _kpblc-conv-vla-to-list) value)) ((= (type value) 'variant) (_kpblc-conv-vla-to-list (vlax-variant-value value))) ((= (type value) 'safearray) (if (>= (vlax-safearray-get-u-bound value 1) 0) (_kpblc-conv-vla-to-list (vlax-safearray->list value)) ) ;_ end of if ) ((and (vlax-property-available-p value 'count)) ;_ end of and (vlax-for sub (_kpblc-conv-ent-to-vla value) (setq res (cons sub res))) ) (t value) ) ;_ end of cond ) ;_ end of defun |
Вызываем _kpblc-menu-get-all-elements с именем нужной нам группы - и получаем полный перечень ее команд (без групп, конечно, но в данный момент это неважно).
Аналогичным образом можно получить и список всех элементов панелей инструментов (это которые Toolbar):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | (defun _kpblc-menu-get-all-toolpars (group-name) ;| * Выводит перечень всех элементов ToolBar указанной группы * Параметры вызова: group-name строка с именем группы ACAD, либо vla-указатель на меню/тулбар * Примеры вызова (_kpblc-menu-get-all-toolpars "test-cad") |; (cond ((and (= (type group-name) 'str) (= (type (setq group-name (vl-catch-all-apply (function (lambda () (vla-item (vla-get-menugroups *kpblc-acad*) group-name))))) ) ;_ end of type 'vla-object ) ;_ end of = ) ;_ end of and (_kpblc-menu-get-all-toolpars group-name) ) ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'toolbars)) (apply (function append) (mapcar (function _kpblc-menu-get-all-toolpars) (_kpblc-conv-vla-to-list (vla-get-toolbars group-name)) ) ;_ end of mapcar ) ;_ end of apply ) ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'count)) (_kpblc-conv-vla-to-list group-name) ) ) ;_ end of cond ) ;_ end of defun |
В коде используются функции _kpblc-conv-vla-to-list и указатель на приложение ACAD (*kpblc-acad*), определенные в предыдущем коде.
Попробуем посмотреть свойства и методы первого попавшегося элемента меню:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | _$ (car (_kpblc-menu-get-all-elements "acad")) #<VLA-OBJECT IAcadPopupMenuItem 00000000242f99a8> _$ (setq mnu (car (_kpblc-menu-get-all-elements "acad"))) #<VLA-OBJECT IAcadPopupMenuItem 00000000242f99a8> _$ (vlax-dump-Object mnu t) ; IAcadPopupMenuItem: A single menu item on an AutoCAD pull-down menu ; Property values: ; Application (RO) = #<VLA-OBJECT IAcadApplication 000000013fc63f10> ; Caption (RO) = "Update" ; Check = 0 ; Enable = -1 ; EndSubMenuLevel = 0 ; HelpString = "Updates image with latest map imagery and optimizes resolution" ; Index (RO) = 3 ; Label = "Update" ; Macro = "\003\003_geomapimageupdate " ; Parent (RO) = #<VLA-OBJECT IAcadPopupMenu 00000000242f96e8> ; SubMenu (RO) = Ошибка ; TagString = "ID_GeoMapImageUpdate" ; Type (RO) = 0 ; Methods supported: ; Delete () T _$ |
Этот элемент можно сделать недоступным:
1 | (vla-put-enable mnu :vlax-false) |
Можно поставить ему флажок:
1 | (vla-put-checked mnu :vlax-true) |
И все это будет прекрасно работать!
Но вот метод Delete... Вот как раз его применять и не советую. Я не знаю, по каким причинам, но при удалении элементов меню и / или элементов панелей инструментов AutoCAD начинает вести себя очень неадекватно (проверял на 2016x64 и 2018x64; английская и русская версии; установлены все обновления):
- При загрузке можно влегкую получить сообщение ошибки ядра 0x0000005c, если я не ошибся с количеством нулей
- Вызвать VLIDE еще получится, но вот загрузить в него хотя бы один lsp-файл у меня уже не вышло. То же самое сообщение об ошибке ядра (правда, теперь в консоли VLIDE), и гарантированный вылет ACAD'a
Поэтому придется при возникновении подобных задач просто создавать несколько похожих CUIX и предоставлять уже их.
