ADN Open CIS
Сообщество программистов Autodesk в СНГ

13/12/2017

Что не стоит делать лиспом в меню

Некоторые действия, вполне допустимые с точки зрения программы, могут привести к неожиданному результату.

Допустим, нам надо после загрузки нашего частичного меню слегка модифицировать команды. Имею в виду команды из выпадающего меню и из палитр инструментов.

Так вот, добраться до нужной команды не так уж и сложно:

Код - Auto/Visual LISP: [Выделить]
  1. (vl-load-com)
  2. (setq *kpblc-acad* (vlax-get-acad-object))
  3.  
  4. (defun _kpblc-menu-get-all-elements (group-name)
  5.                                     ;|
  6. *    Выводит перечень всех элементов меню, в том числе и вложенных, как перечень vla-указателей.
  7. *    Параметры вызова:
  8.   group-name   строка с именем группы меню в ACAD, либо vla-указатель на родителя
  9. *    Примеры вызова:
  10. (_kpblc-menu-get-all-elements "test-menu")
  11. |;
  12.   (cond ((and (= (type group-name) 'str)
  13.               (= (type (setq group-name (vl-catch-all-apply (function (lambda () (vla-item (vla-get-menugroups *kpblc-acad*) group-name)))))
  14.                        ) ;_ end of type
  15.                  'vla-object
  16.                  ) ;_ end of =
  17.               ) ;_ end of and
  18.          (_kpblc-menu-get-all-elements group-name)
  19.          )
  20.         ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'menus))
  21.          (apply (function append)
  22.                 (mapcar (function _kpblc-menu-get-all-elements)
  23.                         (_kpblc-conv-vla-to-list (vla-get-menus group-name))
  24.                         ) ;_ end of mapcar
  25.                 ) ;_ end of apply
  26.          )
  27.         ((and (= (type group-name) 'vla-object)
  28.               (vlax-property-available-p group-name 'submenu)
  29.               (vlax-property-available-p group-name 'type)
  30.               (= (vla-get-type group-name) acmenusubmenu)
  31.               ) ;_ end of and
  32.          (apply (function append)
  33.                 (mapcar (function _kpblc-menu-get-all-elements)
  34.                         (_kpblc-conv-vla-to-list (vla-get-submenu group-name))
  35.                         ) ;_ end of mapcar
  36.                 ) ;_ end of apply
  37.          )
  38.         ((and (= (type group-name) 'vla-object) (not (vlax-property-available-p group-name 'type)))
  39.          (apply (function append)
  40.                 (mapcar (function _kpblc-menu-get-all-elements) (_kpblc-conv-vla-to-list group-name))
  41.                 ) ;_ end of apply
  42.          )
  43.         ((and (= (type group-name) 'vla-object)
  44.               (vlax-property-available-p group-name 'type)
  45.               (= (vla-get-type group-name) acmenuitem)
  46.               ) ;_ end of and
  47.          (list group-name)
  48.          )
  49.         ) ;_ end of cond
  50.   ) ;_ end of defun
  51.  
  52. (defun _kpblc-conv-vla-to-list (value / res) ;|
  53. *    Преобразовывает vla-, vlax-variant или vlax-safearray в список.
  54. |;
  55.   (cond ((listp value) (mapcar (function _kpblc-conv-vla-to-list) value))
  56.         ((= (type value) 'variant) (_kpblc-conv-vla-to-list (vlax-variant-value value)))
  57.         ((= (type value) 'safearray)
  58.          (if (>= (vlax-safearray-get-u-bound value 1) 0)
  59.            (_kpblc-conv-vla-to-list (vlax-safearray->list value))
  60.            ) ;_ end of if
  61.          )
  62.         ((and (vlax-property-available-p value 'count)) ;_ end of and
  63.          (vlax-for sub (_kpblc-conv-ent-to-vla value) (setq res (cons sub res)))
  64.          )
  65.         (t value)
  66.         ) ;_ end of cond
  67.   ) ;_ end of defun

Вызываем _kpblc-menu-get-all-elements с именем нужной нам группы - и получаем полный перечень ее команд (без групп, конечно, но в данный момент это неважно).

Аналогичным образом можно получить и список всех элементов панелей инструментов (это которые Toolbar):

Код - Auto/Visual LISP: [Выделить]
  1. (defun _kpblc-menu-get-all-toolpars (group-name)
  2.                                     ;|
  3. *    Выводит перечень всех элементов ToolBar указанной группы
  4. *    Параметры вызова:
  5.   group-name    строка с именем группы ACAD, либо vla-указатель на меню/тулбар
  6. *    Примеры вызова
  7. (_kpblc-menu-get-all-toolpars "test-cad")
  8. |;
  9.   (cond ((and (= (type group-name) 'str)
  10.               (= (type (setq group-name (vl-catch-all-apply (function (lambda () (vla-item (vla-get-menugroups *kpblc-acad*) group-name)))))
  11.                        ) ;_ end of type
  12.                  'vla-object
  13.                  ) ;_ end of =
  14.               ) ;_ end of and
  15.          (_kpblc-menu-get-all-toolpars group-name)
  16.          )
  17.         ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'toolbars))
  18.          (apply (function append)
  19.                 (mapcar (function _kpblc-menu-get-all-toolpars)
  20.                         (_kpblc-conv-vla-to-list (vla-get-toolbars group-name))
  21.                         ) ;_ end of mapcar
  22.                 ) ;_ end of apply
  23.          )
  24.         ((and (= (type group-name) 'vla-object) (vlax-property-available-p group-name 'count))
  25.          (_kpblc-conv-vla-to-list group-name)
  26.          )
  27.         ) ;_ end of cond
  28.   ) ;_ end of defun

В коде используются функции _kpblc-conv-vla-to-list и указатель на приложение ACAD (*kpblc-acad*), определенные в предыдущем коде.

Попробуем посмотреть свойства и методы первого попавшегося элемента меню:

Код - Auto/Visual LISP: [Выделить]
  1. _$ (car (_kpblc-menu-get-all-elements "acad"))
  2. #
  3. _$ (setq mnu (car (_kpblc-menu-get-all-elements "acad")))
  4. #
  5. _$ (vlax-dump-Object mnu t)
  6. ; IAcadPopupMenuItem: A single menu item on an AutoCAD pull-down menu
  7. ; Property values:
  8. ;   Application (RO) = #
  9. ;   Caption (RO) = "Update"
  10. ;   Check = 0
  11. ;   Enable = -1
  12. ;   EndSubMenuLevel = 0
  13. ;   HelpString = "Updates image with latest map imagery and optimizes resolution"
  14. ;   Index (RO) = 3
  15. ;   Label = "Update"
  16. ;   Macro = "\003\003_geomapimageupdate "
  17. ;   Parent (RO) = #
  18. ;   SubMenu (RO) = Ошибка
  19. ;   TagString = "ID_GeoMapImageUpdate"
  20. ;   Type (RO) = 0
  21. ; Methods supported:
  22. ;   Delete ()
  23. T
  24. _$

Этот элемент можно сделать недоступным:(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 в 20:39:18