Сообщество программистов Autodesk в СНГ :: Основной файл меню AutoCAD

31/03/2014

Основной файл меню AutoCAD

Как было сказано в статьях "Последовательность загрузки приложений в AutoCAD" и "Последовательность загрузки приложений в AutoCAD с учетом SECURELOAD", можно организовать загрузку своих приложений, используя mnl-файлы. Чем я до поры до времени успешно и пользовался.

Но, к сожалению, не все так легко и просто.

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

Поэтому, если планируется тестирование нескольких файлов меню, придется либо мириться с бардаком в загруженных частичных файлах меню, либо создавать отдельный каталог, в который копировать “чистые” файлы основного меню и сопутствующие им (т.е. mnl, dll), устанавливать эту копию в качестве основного файла меню и уже потом подгружать свои файлы. Конечно, можно и третий / четвертый / пятый путь придумать, но мне было лень

Так что я выбирал между двумя.

Меня бардак не сильно устраивает, поэтому я пошел по второму пути. Идеальным вариантом, конечно, был бы “сохранить где-то в определенном месте абсолютно чистые файлы меню”, но ситуации бывают разные. Именно для этих разных ситуаций и будем “рисовать” код.

Как всегда, перед вызовом VLIDE не помешает подумать – что и в каком виде будем обрабатывать и передавать.

Нам необходимо будет определить каталог, в котором хранятся все файлы меню – и касается это прежде всего, конечно, основного меню. Файлы стандартных частичных меню туда закидывать особого смысла лично я не вижу, поэтому про них просто забудем

Также в качестве параметра понадобится имя файла погружаемого собственного меню. Было бы неплохо также и имя группы меню, которое он импортирует, но это не критично. Для упрощения будем считать, что нам известно не только имя файла, но и имя импортируемой группы меню – так работать значительно проще.

Вроде бы все, ничего не забыл. Поехали.

Итак, прежде всего – определяем каталог, в котором будут храниться файлы основного меню и нашего тестируемого кусочка. Я обычно для таких целей использую каталог %AppData% – еще ни разу не встречал ситуации, чтобы туда нельзя было бы выполнять запись. Но просто %AppData% использовать по меньшей мере неразумно, поэтому я там организовываю подкаталог (kpblc), потом имя приложения (ну, например, LispRu). Дальше, учитывая, что меню обычно тестируется как минимум на 2-3 версиях AutoCAD, а то и вертикальные решения начинают вносить свою лепту, указываю имя приложения с учетом его версии, локализации и разрядности. Так, например, для AutoCAD 2014 x64 Eng следующим подкаталогом будет ACA2014x64En, для AutoCAD Civil 3D 2014 Rus – ACAC2014x64Ru и т.п.

Таким образом, получается, что надо создавать каталог вида %AppData%\kpblc\LispRu\ACA2014x64Ru

Все? Нет, не все. У AutoCAD могут быть разные профили (смотрим справку, ключи вызова). Так что понадобится еще добавить имя профиля AutoCAD, не забывая про недопустимые символы. Ну и для полного счастья остается добавить подкаталог menu, откуда собственно и будет все наше счастье загружаться.

Значит, результатом будет

%AppData%\kpblc\LispRu\{Приложение}{Версия}{Разрядность}{Локализация}\{ИмяПрофиля}\menu

Ффух, теперь уж точно все касательно каталога. Поскольку подобная информация может потребоваться не раз и не два, возникает вопрос – то ли вычислять ее, то ли где-то хранить. Я пока предпочитаю вычислять.

Сначала вычислим путь, а уже потом будем его создавать

Вычисляем %AppData%. Казалось бы, тут ничего сложного нет:

Код - Auto/Visual LISP: [Выделить]

(getenv "AppData")

должен вернуть все что надо. Но, к сожалению, именно должен. А не обязан. На некоторых версиях Windows вместо ожидаемого, к примеру C:\Document and Settings\DomainUser можно запросто получить C:\DOCUME~1\DOMAIN~2
На Windows 7 я такого, конечно, уже не встречал, но предусмотреть подобное поведение не помешает.

Итак, для того, чтобы получить каталог %AppData%, сначала попробуем проанализировать (getenv “AppData”) на предмет содержания в нем символов ~, и, если таковые будут обнаружены, полезем в реестр:

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-get-path-appdata-current-user (/)
                                            ;|
* Получение пути установок, хранимых на локальной машине. (CurrUser)
|;
  (strcat
    (_kpblc-dir-path-and-splash
      (cond
        ((not (wcmatch (getenv "AppData") "*~*"))
         (getenv "AppData")
         )
        (t
         (_kpblc-dir-path-and-splash
           (vl-registry-read
             "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
             "AppData"
             ) ;_ end of vl-registry-read
           ) ;_ end of _kpblc-dir-path-and-splash
         )
        ) ;_ end of cond
      ) ;_ end of _kpblc-dir-path-and-splash
    "kpblc"
    ) ;_ end of strcat
  ) ;_ end of defun

Тут используется одна служебная функция, возвращающая каталог с гарантированным слешем на конце:

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-dir-path-and-splash (path)
                                  ;|
* Возвращает путь со слешем в конце
* Параметры вызова:
     path - обрабатываемый путь
* Примеры вызова: (_kpblc-dir-path-and-splash "c:\\kpblc-cad") ; "c:\\kpblc-cad\\"
|;
  (strcat (vl-string-right-trim "\\" path)
          "\\"
          ) ;_ end of strcat
  ) ;_ end of defun

Вспомним, что надо получить в результате (я время от времени буду напоминать это дело):

%AppData%\kpblc\LispRu\{Приложение}{Версия}{Разрядность}{Локализация}\{ИмяПрофиля}\menu

Теперь пришла очередь {Приложение}. Я пошел по пути получения имени приложения из реестра и последующего его преобразования в более короткий и понятный вид.

Для преобразования понадобятся две функции: преобразование строки в список (обратная задача прямо тут не понадобится)

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-conv-string-to-list (string separator / i)
                                  ;|
*    Функция разбора строки. Возвращает список либо точечную пару
*    Параметры вызова:
        string      разбираемая строка
        separator   символ, используемый в качестве разделителя частей
*    Примеры вызова:
(_kpblc-conv-string-to-list "1;2;3;4;5;6" ";") ;'(1 2 3 4 5 6)
(_kpblc-conv-string-to-list "1;2" ";")         ;'(1 2)
*    За основу взяты уроки Евгения Елпанова по рекурсиям |;
  (cond
    ((= string "") nil)
    ((vl-string-search separator string)
     ((lambda (/ pos res)
        (while (setq pos (vl-string-search separator string))
          (setq res    (cons (substr string 1 pos) res)
                string (substr string (+ (strlen separator) 1 pos))
                ) ;_ end of setq
          ) ;_ end of while
        (reverse (cons string res))
        ) ;_ end of lambda
      )
     )
    ((wcmatch (strcase string)
              (strcat "*" (strcase separator) "*")
              ) ;_ end of wcmatch
     ((lambda (/ pos res _str prev)
        (setq pos  1
              prev 1
              _str (substr string pos)
              ) ;_ end of setq
        (while (

Получим собственно имя приложения. Читать будем из

HKEY_LOCAL_MACHINE\Software\Autodesk\<И
    что-то тут>

. Учтем по ходу дела тот факт, что, например, в Civil 3D или AutoCAD Architecture есть уникальные ключи, в которых хранится короткое имя приложения (в AutoCAD таких ключей, например, нет).

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-get-acad-product-name (/ res)
                                    ;|
*    Возвращает имя приложения, с указанием разрядности и локализации
|;
  (strcat
    (cond
      ((setq res (vl-registry-read
                   (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key))
                   "ProductNameShort"
                   ) ;_ end of vl-registry-read
             ) ;_ end of setq
       (vl-string-subst "" " " res)
       )
      ((setq res (vl-registry-read
                   (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key))
                   "ProductName"
                   ) ;_ end of vl-registry-read
             ) ;_ end of setq
       (apply (function strcat)
              (vl-remove-if-not
                (function (lambda (x) (wcmatch (strcase x) "*CAD,####")))
                (_kpblc-conv-string-to-list res " ")
                ) ;_ end of vl-remove-if-not
              ) ;_ end of apply
       )
      ) ;_ end of cond
    "x"
    (if (wcmatch (getvar "platform") "*x64*")
      "64"
      "32"
      ) ;_ end of if
    (cond ((= (vl-registry-read
                (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key))
                "LocaleId"
                ) ;_ end of vl-registry-read
              "409"
              ) ;_ end of =
           "En"
           )
          ((=
             (vl-registry-read
               (strcat "HKEY_LOCAL_MACHINE\\" (vlax-product-key))
               "LocaleId"
               ) ;_ end of vl-registry-read
             "419"
             ) ;_ end of =
           "Ru"
           )
          (t "UnKnown")
          ) ;_ end of cond
    ) ;_ end of strcat
  ) ;_ end of defun

Вызов функции в AutoCAD 2014 x64 Eng вернет "AutoCAD2014x64Eng", Civil 3D 2014 x64 Rus – "C3D2014x64Ru" и т.п.

Теперь имя профиля. Вроде бы и тут ничего сложного быть не должно – (getvar “cprofile”) и ура. Но в имени профиля запросто могут подержаться символы, неподдерживаемые файловой системой (самый яркий пример – <<профиль без имени>>. Имя профиля содержит запрещенных символы < и >). То есть, получив имя профиля, оттуда надо убрать неправильные символы:

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-get-profile-name ()
                               ;|
*    Замена стандартному (getvar "cprofile")
|;
  (vl-list->string
    (vl-remove-if-not
      (function (lambda (x)
                  (or (<= 48 x 57)
                      (<= 65 x 90)
                      (

Ну и напоследок – собственно создание каталога.

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-dir-create (path / tmp)
                         ;|
*    Гарантированное создание каталога. * Параметры вызова: path создаваемый каталог
|;
  (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

Теперь в каталог, созданный через

Код - Auto/Visual LISP: [Выделить]

(_kpblc-dir-create
  (strcat (_kpblc-get-path-appdata-current-user)
          "\\LispRu\\"
          (_kpblc-get-acad-product-name)
          "\\"
          (_kpblc-get-profile-name)
          "\\menu"
          ) ;_ end of strcat
  ) ;_ end of _kpblc-dir-create

надо будет копировать основной файл меню (который придется вычислять), его сопутствующие файлы (dll / mnl),и загружаемые файлы частичных меню (не забывая про те же dll, mnl и удаление – на всякий случай – mnr и mnc).

После копирования файла основного меню я сначала допустил ошибку: сразу устанавливал копию в качестве основного файла меню. Даже при условии программной загрузки остальных частичных файлов меню вид AutoCAD’а мог накрыться. Проблема кроется в несохраненном рабочем пространстве.

Т.е. перед выполнением следующих шагов надо

получить текущее значение системной переменной WSCURRENT;
сохранить рабочее пространство;
установить новый файл основного меню;
восстановить WSCURRENT.

Позволю себе пофилонить и полностью все проверки не прописывать (ну, например, я принципиально "забыл" о существовании AutoCAD версий до 2005 включительно).

Для работы понадобятся еще 3 функции – преобразования указателей в ename, в vla и vla в список. Конечно, можно поизвращаться и без них обойтись, но моя практика показала необходимость подобных функций:

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-conv-ent-to-ename (ent_value / _lst)
                                ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
  ent_value значение, которое надо преобразовать в примитив. Может быть именем примитива, vla-указателем или просто
            списком.
*    Если не принадлежит ни одному из указанных типов, возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
|;
  (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))
              ) ;_ end of and
         (handent ent_value)
         )
        ((and (= (type ent_value) 'str)
              (handent ent_value)
              (tblobjname "style" ent_value)
              ) ;_ end of and
         (tblobjname "style" ent_value)
         )
        ((and (= (type ent_value) 'str)
              (handent ent_value)
              (tblobjname "dimstyle" ent_value)
              ) ;_ end of and
         (tblobjname "dimstyle" ent_value)
         )
        ((and (= (type ent_value) 'str)
              (handent ent_value)
              (tblobjname "block" ent_value)
              ) ;_ end of and
         (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)
                              ;|
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
        ent_value значение, которое надо преобразовать в указатель. Может
                  быть именем примитива, vla-указателем или просто
                  списком. Если не принадлежит ни одному из указанных типов,
                  возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-vla (entlast))
(_kpblc-conv-ent-to-vla (vlax-ename->vla-object (entlast)))
|;
  (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-conv-vla-to-list (value / res)
                               ;|
*    Преобразовывает 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 (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 vlax-property-available-p
              ) ;_ end of and
         (vlax-for sub (_kpblc-conv-ent-to-vla value)
           (setq res (cons sub res))
           ) ;_ end of vlax-for
         )
        (t value)
        ) ;_ end of cond
  ) ;_ end of defun

В результате получается:

Код - Auto/Visual LISP: [Выделить]

(defun _kpblc-menu-update2 (/ loc_dir main_menu)
                           ;|
*    Обновление файла меню
|;
  (setq loc_dir   (_kpblc-dir-create
                    (strcat (_kpblc-get-path-appdata-current-user)
                            "\\LispRu\\"
                            (_kpblc-get-acad-product-name)
                            "\\"
                            (_kpblc-get-profile-name)
                            "\\menu"
                            ) ;_ end of strcat
                    ) ;_ end of _kpblc-dir-create
        main_menu (vla-get-menufile
                    (vla-get-files
                      (vla-get-preferences (vlax-get-acad-object))
                      ) ;_ end of vla-get-files
                    ) ;_ end of vla-get-menufile
        ) ;_ end of setq
  (if (/= (_kpblc-dir-path-and-splash
            (strcase (vl-filename-directory main_menu))
            ) ;_ end of _kpblc-dir-path-and-splash
          (_kpblc-dir-path-and-splash (strcase loc_dir))
          ) ;_ end of /=
    (progn
      ;; Каталоги не совпадают. Надо копировать и устанавливать новый основной файл меню
      ;; не забывая про все остальное
      ;; Удаляем старые варианты,- вдруг они там есть
      (foreach file (vl-directory-files
                      loc_dir
                      (strcat (vl-filename-base main_menu) ".*")
                      1
                      ) ;_ end of vl-directory-files
        (vl-file-delete
          (strcat (_kpblc-dir-path-and-splash loc_dir) file)
          ) ;_ end of vl-file-delete
        ) ;_ end of foreach
      ;; Теперь копируем из текущего положения основного файла меню все необходимое
      (foreach file
               (vl-remove-if-not
                 (function
                   (lambda (x)
                     (wcmatch
                       (strcase
                         (vl-string-trim "." (vl-filename-extension x))
                         ) ;_ end of strcase
                       "CUI,CUIX,MNL,MNS,MNU,DLL,MNL"
                       ) ;_ end of wcmatch
                     ) ;_ end of lambda
                   ) ;_ end of function
                 (vl-directory-files
                   (vl-filename-directory main_menu)
                   (strcat (vl-filename-base main_menu) ".*")
                   1
                   ) ;_ end of vl-directory-files
                 ) ;_ end of vl-remove-if-not
        (vl-file-copy
          (strcat (_kpblc-dir-path-and-splash
                    (vl-filename-directory main_menu)
                    ) ;_ end of _kpblc-dir-path-and-splash
                  file
                  ) ;_ end of strcat
          (strcat (_kpblc-dir-path-and-splash loc_dir) file)
          ) ;_ end of vl-file-copy
        ) ;_ end of foreach
      ;; Теперь получаем список уже загруженных файлов частичных меню.
      ;; Потом мы их снова загрузим
      ;; Получим общий список и из него исключим файл основного меню,
      ;; и файлы меню в loc_dir
      (setq partial_menus
             (vl-remove-if
               (function
                 (lambda (x)
                   (or
                     (= (strcase (cdr (assoc "name" x)))
                        (strcase (vl-filename-base main_menu))
                        ) ;_ end of =
                     (wcmatch (strcase (vl-filename-directory
                                         (cdr (assoc "name" x))
                                         ) ;_ end of vl-filename-directory
                                       ) ;_ end of strcase
                              (strcat (strcase loc_dir "*"))
                              ) ;_ end of wcmatch
                     ) ;_ end of or
                   ) ;_ end of lambda
                 ) ;_ end of function
               (mapcar
                 (function
                   (lambda (x)
                     (list
                       (cons "name" (vla-get-name x))
                       (cons "file" (vla-get-menufilename x))
                       ) ;_ end of list
                     ) ;_ end of lambda
                   ) ;_ end of function
                 (_kpblc-conv-vla-to-list
                   (vla-get-menugroups (vlax-get-acad-object))
                   ) ;_ end of _kpblc-conv-vla-to-list
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if
            ) ;_ end of setq
      ;; Сохраняем текущее рабочее пространство
      (if (setq wscurrent (getvar "wscurrent"))
        (command "_.wssave" wscurrent "_y")
        ) ;_ end of if
      ;; Меняем основной файл меню
      (vla-load
        (vla-get-menugroups
          (vla-get-activedocument (vlax-get-acad-object))
          ) ;_ end of vla-get-menugroups
        (findfile
          (strcat
            (_kpblc-dir-path-and-splash loc_dir)
            (car
              (vl-remove-if
                (function (lambda (x) (wcmatch (strcase x) "*.bak.cui*"))
                          ) ;_ end of function
                (vl-directory-files
                  loc_dir
                  (strcat (vl-filename-base main_menu) ".cui*")
                  ) ;_ end of vl-directory-files
                ) ;_ end of vl-remove-if
              ) ;_ end of car
            ) ;_ end of strcat
          ) ;_ end of findfile
        :vlax-true
        ) ;_ end of vla-load
      (foreach item partial_menus
        (vl-catch-all-apply
          (function
            (lambda ()
              (vla-load (vla-get-menugroups
                          (vla-get-activedocument (vlax-get-acad-object))
                          ) ;_ end of vla-get-menugroups
                        (cdr (assoc "file" item))
                        :vlax-false
                        ) ;_ end of vla-load
              ) ;_ end of lambda
            ) ;_ end of function
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of foreach
      ;; Для ExpressTools немного "своя" доработка
      (if (findfile "acettest.fas")
        (progn (load "acettest.fas")
               (vla-sendcommand
                 (vla-get-activedocument (vlax-get-acad-object))
                 "_expresstools "
                 ) ;_ end of vla-sendcommand
               ) ;_ end of progn
        ) ;_ end of if
      ;; Восстанавливаем рабочее пространство
      (if wscurrent
        (progn (setvar "wscurrent" wscurrent)
               (command "_.wssave" wscurrent "_y")
               ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

К сожалению, тщательное тестирование кода показало, что попытки выполнения строк наподобие

Код - Auto/Visual LISP: [Выделить]

(vla-load (vla-get-menugroups (vla-get-activedocument
    (vlax-get-acad-object))) new_main_menu :vlax-false)

в 64-разрядных AutoCAD версий 2009, 2013, 2014 (в остальных просто не пробовал) выполнение подобной конструкции (vla-load … :vlax-true) приводит к ошибке ядра! Отловить подобное лиспом невозможно.

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

Код - Auto/Visual LISP: [Выделить]

(command
    "_.menu" new_main_menu)

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

На основе материалов статей
Продолжаю войну с меню… и Смена файла основного меню

Обсуждение: http://adn-cis.org/forum/index.php?topic=646

Опубликовано 31.03.2014
Отредактировано 21.01.2015 в 21:40:55