Что не стоит делать лиспом в меню
Некоторые действия, вполне допустимые с точки зрения программы, могут привести к неожиданному результату.
Допустим, нам надо после загрузки нашего частичного меню слегка модифицировать команды. Имею в виду команды из выпадающего меню и из палитр инструментов.
Так вот, добраться до нужной команды не так уж и сложно:
- (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):
- (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*), определенные в предыдущем коде.
Попробуем посмотреть свойства и методы первого попавшегося элемента меню:
- _$ (car (_kpblc-menu-get-all-elements "acad"))
- #
- _$ (setq mnu (car (_kpblc-menu-get-all-elements "acad")))
- #
- _$ (vlax-dump-Object mnu t)
- ; IAcadPopupMenuItem: A single menu item on an AutoCAD pull-down menu
- ; Property values:
- ; Application (RO) = #
- ; 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) = #
- ; SubMenu (RO) = Ошибка
- ; TagString = "ID_GeoMapImageUpdate"
- ; Type (RO) = 0
- ; Methods supported:
- ; Delete ()
- T
- _$
Этот элемент можно сделать недоступным:(vla-put-enable mnu :vlax-false)
Можно поставить ему флажок: (vla-put-checked mnu :vlax-true)
И все это будет прекрасно работать!
Но вот метод Delete... Вот как раз его применять и не советую. Я не знаю, по каким причинам, но при удалении элементов меню и / или элементов панелей инструментов AutoCAD начинает вести себя очень неадекватно (проверял на 2016x64 и 2018x64; английская и русская версии; установлены все обновления):
- При загрузке можно влегкую получить сообщение ошибки ядра 0x0000005c, если я не ошибся с количеством нулей
- Вызвать VLIDE еще получится, но вот загрузить в него хотя бы один lsp-файл у меня уже не вышло. То же самое сообщение об ошибке ядра (правда, теперь в консоли VLIDE), и гарантированный вылет ACAD'a
Поэтому придется при возникновении подобных задач просто создавать несколько похожих CUIX и предоставлять уже их.
Автор: Алексей Кулик.
Обсуждение: http://adn-cis.org/forum/index.php?topic=8194
Опубликовано 13.12.2017Отредактировано 13.12.2017 в 19:39:18
