[Кулик Алексей aka kpblc]

В силу разных причин приходится для разных версий и профилей AutoCAD иметь разные по расположению файлы основного меню. Смену основного файла меню выполняю при старте AutoCAD, только один раз. Код выдран с мясом из рабочей копии:

Код:

[Выделить все]

 (vl-load-com)

(setq *kpblc-acad* (vlax-get-acad-object)
      *kpblc-adoc* (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of setq

(defun test (/ main_menu_file path)
  (setq path           (vl-string-right-trim
                         "\\"
                         (_kpblc-dir-create
                           (strcat (vl-string-right-trim "\\" (getenv "AppData"))
                                   "\\kpblc\\AutoCAD\\"
                                   (_kpblc-acad-version-with-bit-and-loc)
                                   "\\"
                                   (_kpblc-get-profile-name)
                                   ) ;_ end of strcat
                           ) ;_ end of _kpblc-dir-create
                         ) ;_ end of vl-string-right-trim
        main_menu_file (cond ((vl-directory-files
                                (vl-filename-directory (vla-get-menufile (vla-get-files (vla-get-preferences *kpblc-acad*))))
                                (strcat (vl-filename-base (vla-get-menufile (vla-get-files (vla-get-preferences *kpblc-acad*))))
                                        ".*"
                                        ) ;_ end of strcat
                                ) ;_ end of vl-directory-files
                              (vl-filename-base (vla-get-menufile (vla-get-files (vla-get-preferences *kpblc-acad*))))
                              )
                             ((setq main_menu_file
                                     (findfile
                                       (strcat (vl-filename-base (vla-get-menufile (vla-get-files (vla-get-preferences *kpblc-acad*))))
                                               (if (< (_kpblc-acad-version) 18.)
                                                 ".cui"
                                                 ".cuix"
                                                 ) ;_ end of if
                                               ) ;_ end of strcat
                                       ) ;_ end of findfile
                                    ) ;_ end of setq
                              (_kpblc-cmd-silence (list "_.menu" main_menu_file))
                              (vl-filename-base (vla-get-menufile (vla-get-files (vla-get-preferences *kpblc-acad*))))
                              )
                             ) ;_ end of cond
        main_menu_file (car
                         (vl-remove-if-not
                           (function (lambda (x)
                                       (= (strcase (vl-filename-base (cdr (assoc "menufilename" x)))) (strcase main_menu_file))
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                           (mapcar (function (lambda (x)
                                               (mapcar (function (lambda (pr) (cons (strcase pr t) (vlax-get-property x pr))))
                                                       '("name" "menufilename")
                                                       ) ;_ end of mapcar
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                   (_kpblc-conv-vla-to-list (vla-get-menugroups *kpblc-acad*))
                                   ) ;_ end of mapcar
                           ) ;_ end of vl-remove-if-not
                         ) ;_ end of car
        ) ;_ end of setq
  (if (/= (strcase
            (vl-string-right-trim "\\" (vl-filename-directory (cdr (assoc "menufilename" main_menu_file))))
            ) ;_ end of strcase
          (strcase (vl-string-right-trim "\\" path))
          ) ;_ end of /=
    (progn ;; Здесь код упростил, тупо выполняю копирование файла основного меню
           (foreach file (vl-directory-files
                           path
                           (strcat (vl-filename-base (cdr (assoc "menufilename" main_menu_file))) ".*")
                           ) ;_ end of vl-directory-files
             (vl-file-delete (strcat (_kpblc-dir-path-and-splash (_kpblc-get-path-local "menu")) file))
             ) ;_ end of foreach
           (foreach file (vl-remove-if
                           (function
                             (lambda (x)
                               (or (wcmatch (strcase x t) "*.bak.*,*._*") (not (wcmatch (strcase x t) "*.cui*,*.mnl,*.dll")))
                               ) ;_ end of lambda
                             ) ;_ end of function
                           (vl-directory-files
                             (vl-filename-directory (cdr (assoc "menufilename" main_menu_file)))
                             (strcat (vl-filename-base (cdr (assoc "menufilename" main_menu_file))) ".*")
                             1
                             ) ;_ end of vl-directory-files
                           ) ;_ end of vl-remove-if
             (vl-file-copy
               (strcat (vl-string-right-trim "\\" (vl-filename-directory (cdr (assoc "menufilename" main_menu_file))))
                       "\\"
                       file
                       ) ;_ end of strcat
               (strcat path "\\" file)
               ) ;_ end of vl-file-copy
             ) ;_ end of foreach
           ;; И теперь выполняем установку нового файла меню.
           ;; Вариант 1: выполнение прекращается с фатальной ошибкой
           ;|
           (vla-put-menufile
             (vla-get-preferences *kpblc-acad*)
             (strcat path "\\" (vl-filename-base (cdr (assoc "menufilename" main_menu_file))))
             ) ;_ end of vla-put-menufile
             |;
           ;; Вариант 2: выполнение приводит к ошибке ядра (0x000000c5, кажется)
           (vl-cmdf "_.menu"
                    (strcat path
                            "\\"
                            (vl-filename-base (cdr (assoc "menufilename" main_menu_file)))
                            (if (< (atof (getvar "acadver")) 18.)
                              ".cui"
                              ".cuix"
                              ) ;_ end of if
                            ) ;_ end of strcat
                    ) ;_ end of vl-cmdf
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
(defun _kpblc-acad-version-with-bit ()
  (strcat (itoa (atoi (vl-string-trim "VISUALP " (strcase (ver)))))
          "x"
          (if (and (getvar "platform") (wcmatch (strcase (getvar "platform")) "*X64*"))
            "64"
            "32"
            ) ;_ end of if
          ) ;_ end of strcat
  ) ;_ end of defun
(defun _kpblc-acad-version-with-bit-and-loc ()
  (strcat (_kpblc-acad-version-with-bit)
          "-"
          (vl-registry-read (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key)) "LocaleID")
          ) ;_ end of strcat
  ) ;_ end of defun
(defun _kpblc-conv-vla-to-list (value / res)
  (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 (member (type value) (list 'ename 'str 'vla-object))
              (= (type (_kpblc-conv-ent-to-vla value)) 'vla-object)
              (vlax-property-available-p (_kpblc-conv-ent-to-vla 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
(defun _kpblc-conv-ent-to-ename (ent_value / _lst)
  (cond ((= (type ent_value) 'vla-object) (vlax-vla-object->ename ent_value))
        ((= (type ent_value) 'ename) ent_value)
        ((and (= (type ent_value) 'str) (handent ent_value) (entget (handent ent_value)))
         (handent ent_value)
         )
        ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "style" ent_value))
         (tblobjname "style" ent_value)
         )
        ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "dimstyle" ent_value))
         (tblobjname "dimstyle" ent_value)
         )
        ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "block" ent_value))
         (tblobjname "block" ent_value)
         )
        ((and (= (type ent_value) 'list) (cdr (assoc -1 ent_value))) (cdr (assoc -1 ent_value)))
        (t nil)
        ) ;_ end of cond
  ) ;_ end of defun
(defun _kpblc-conv-ent-to-vla (ent_value / res)
  (cond ((= (type ent_value) 'vla-object) ent_value)
        ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
        ((setq res (_kpblc-conv-ent-to-ename ent_value)) (vlax-ename->vla-object res))
        ) ;_ end of cond
  ) ;_ end of defun
(defun _kpblc-get-profile-name ()
  (vl-list->string
    (vl-remove-if-not
      (function
        (lambda (x) (or (<= 48 x 57) (<= 65 x 90) (<= 97 x 122) (= x 32) (<= 224 x 255) (<= 192 x 223)))
        ) ;_ end of function
      (vl-string->list (getvar "cprofile"))
      ) ;_ end of vl-remove-if
    ) ;_ end of VL-LIST->STRING
  ) ;_ end of defun
(defun _kpblc-dir-create (path / tmp)
  (cond ((vl-file-directory-p path) path)
        ((setq tmp (_kpblc-dir-create (vl-filename-directory path)))
         (vl-mkdir (strcat tmp
                           "\\"
                           (vl-filename-base path)
                           (cond ((vl-filename-extension path))
                                 (t "")
                                 ) ;_ end of cond
                           ) ;_ end of strcat
                   ) ;_ end of vl-mkdir
         (if (vl-file-directory-p path)
           path
           ) ;_ end of if
         )
        ) ;_ end of cond
  ) ;_ end of defun

Частичные меню можно (на данный момент) игнорировать. Пути поиска устанавливаются в другом месте и гарантированно содержат новый путь к основному меню. Проблемные места выделены в функции test, в комментариях со словами "Вариант ".
Если вручную выполнить команду _,menu, то все срабатывает корректно, ошибка не появляется. Проблему необходимо решить для AutoCAD 2009 и 2013, а также вертикалок (Map3D, Civil), независимо от локализации и разрядности. Собственно вопрос: где и что я не учел? Что можно сделать, чтобы смена основного файла меню не приводила ни к фатальным ошибкам, ни (в идеале) не требовала перезапуска AutoCAD?
Спасибо.

[P_S]

Навскидку: по первому варианту, наверное, надо

Код:

[Выделить все]

 (vla-put-menufile(vla-get-files(vla-get-preferences *kpblc-acad*)... и т. д.

Будет время, буду дальше думать.

[Кулик Алексей aka kpblc]

Не срабатывало, вываливало ошибку. Александр Ривилис подсказал пару других путей, как попробую - расскажу о результатах.

[P_S]

По ходу дела думал, и решил, что конфликт возникает за счет того, что в коллекции MenuGroups может быть только одна группа меню типа acBaseMenuGroup. Вероятно, при работе через интерфейс программы, за кадром, для этой группы выполняются методы Unload и Load, а в лисповской программе этого не происходит. Значит, надо принудительно (и Load с опцией BaseMenu).

[Кулик Алексей aka kpblc]

Если коротко, выяснилось следующее:
Прежде всего не забыть поменять пути поиска AutoCAD (у меня-то это в реальной версии делается, здесь просто не приводил). Дальше, потребуется копирование не только cui/cuix, то и mnl и dll (если, конечно, они существуют). Конструкция типа (vla-load FllCuiName :vlax-true) срабатывает корректно. Но в некоторых случаях сразу после ее применения необходимо выполнить (princ), чтобы AutoCAD "подхватил" изменения. После установки основного файла меню почти гарантированно потребуется установить рабочее пространство.
Ошибка выполнения возникала в строке обращения к внедокументной переменной через vl-bb-set - вот уж чего не ожидал...

[gomer]

Сообщение от Кулик Алексей aka kpblc Дальше, потребуется копирование не только cui/cuix, то и mnl и dll (если, конечно, они существуют).

Копирование куда?

[Кулик Алексей aka kpblc]

Туда же, куда и основное меню копируется - в тот самый "отдельный" каталог.

[gomer]

Сообщение от Кулик Алексей aka kpblc в тот самый "отдельный" каталог.

Отдельный каталог где? на рабочей станции, на сервере, в облаке?

[Кулик Алексей aka kpblc]

Ну, пока есть возможность, расскажу
Когда выполняется загрузка дополнительных (partial) меню, или меняется порядок их следования, то все эти изменения записываются в основной файл меню. Если надо в разных профилях AutoCAD иметь разные наборы частичных меню (а вместе с ними могут быть и разные mnl), то приходится извращаться, "разделяя" основной файл меню. Для каждого профиля AutoCAD в таком случае должен быть свой "основной" файл меню.
Например, есть частичные меню: test1.cui, test1.dll, test1.mnl и test2.cui, test2.mnl. Есть два разных профиля AutoCAD: "Test1 profile" и "Test2 profile". В первом должно быть подгружено только меню test1, во втором - только test2, независимо от текущего рабочего пространства. По-моему, сделать такой финт без того, чтобы каждому профилю назначить свой основной файл меню, невозможно.