Логика работы корпоративного файла адаптации cuix

Автор Тема: Логика работы корпоративного файла адаптации cuix  (Прочитано 5549 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 745
  • Карма: 111
Кстати, у меня достаточно давно уже правило: имя файла меню = имя группы меню. Если у тебя это не так, надо будет немного поизвращаться ;)
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 745
  • Карма: 111
О, пока сообразил... Права пользователей меняться будут? Ну то есть, грубо говоря, сегодня человеку надо один набор меню, завтра что-то удалить, что-то добавить.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Олег Боровой

  • ADN OPEN
  • Сообщений: 2
  • Карма: 0
Цитировать
Код могу написать, конечно, но там тьма данных будет прописана прямо в него. Надо?
Спасибо за ответ. Если не сложно пришлите код. Очень интересно взглянуть на ваш метод.
Я использовал acad.lsp (генерируемый динамически при логоне), поскольку посчитал это наиболее простым способом загружать общие и специализированные меню и прописывать пути для поддержки в каждый акадовский профиль создаваемый пользователем.

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 745
  • Карма: 111
Нечто типа такого (писал, понятно, без проверки)
Код - Auto/Visual Lisp [Выбрать]
  1. (defun menu-update (/ _kpblc-dir-create _kpblc-dir-path-and-splash _kpblc-get-file-date cur_user server loc_path loc_lst server_lst cui)
  2.   (defun _kpblc-get-file-date (file / lst res copy)
  3.     (if (findfile file)
  4.       (if (setq lst (vl-file-systime file))
  5.         (foreach item '((0 . 4) (1 . 2) (3 . 2) (4 . 2) (5 . 2) (6 . 2))
  6.           (setq res (append res
  7.                             (list ((lambda (/ tmp)
  8.                                      (setq tmp (itoa (nth (car item) lst)))
  9.                                      (while (< (strlen tmp) (cdr item)) (setq tmp (strcat "0" tmp)))
  10.                                      tmp
  11.                                      ) ;_ end of LAMBDA
  12.                                    )
  13.                                   ) ;_ end of list
  14.                             ) ;_ end of append
  15.                 ) ;_ end of setq
  16.           ) ;_ end of foreach
  17.         (progn (setq copy (strcat (_kpblc-get-path-temp) "\\" (vl-filename-base file) (vl-filename-extension file)))
  18.                (vl-file-copy file copy)
  19.                (setq res (_kpblc-get-file-date copy))
  20.                ) ;_ end of progn
  21.         ) ;_ end of if
  22.       ) ;_ end of if
  23.     (cond ((and res (listp res)) (apply 'strcat res))
  24.           (res)
  25.           ) ;_ end of cond
  26.     ) ;_ end of defun
  27.   (defun _kpblc-dir-create (path / tmp)
  28.     (cond ((vl-file-directory-p path) path)
  29.           ((setq tmp (_kpblc-dir-create (vl-filename-directory path)))
  30.            (vl-mkdir (strcat tmp
  31.                              "\\"
  32.                              (vl-filename-base path)
  33.                              (cond ((vl-filename-extension path))
  34.                                    (t "")
  35.                                    ) ;_ end of cond
  36.                              ) ;_ end of strcat
  37.                      ) ;_ end of vl-mkdir
  38.            (if (vl-file-directory-p path)
  39.              path
  40.              ) ;_ end of if
  41.            )
  42.           ) ;_ end of cond
  43.     ) ;_ end of defun
  44.   (defun _kpblc-dir-path-and-splash (path) (strcat (vl-string-right-trim "\\" path) "\\"))
  45.   (setq server   "\\\\server\\acad\\menus"
  46.         loc_path (strcat (_kpblc-dir-path-and-splash (getenv "appdata")) "kpblc\\adn-cis")
  47.         ) ;_ end of setq
  48.   (if (setq cur_user (cdr
  49.                        (assoc "menu"
  50.                               (car
  51.                                 (vl-remove-if-not (function (lambda (x)
  52.                                                               (and (wcmatch (strcase (getenv "username"))
  53.                                                                             (cond ((cdr (assoc "name" x)) (strcase (cdr (assoc "name" x))))
  54.                                                                                   (t "*")
  55.                                                                                   ) ;_ end of cond
  56.                                                                             ) ;_ end of wcmatch
  57.                                                                    (wcmatch (strcase (getenv "userdomain"))
  58.                                                                             (cond ((cdr (assoc "domain" x)) (strcase (cdr (assoc "domain" x))))
  59.                                                                                   (t "*")
  60.                                                                                   ) ;_ end of cond
  61.                                                                             ) ;_ end of wcmatch
  62.                                                                    ) ;_ end of and
  63.                                                               ) ;_ end of lambda
  64.                                                             ) ;_ end of function
  65.                                                   ;; Список пользователей
  66.                                                   '
  67.                                                    ((("name" . "kpblc") ("menu" "test1" "test2"))
  68.                                                     (("name" . "oleg") ("domain" . "home") ("menu" "check1"))
  69.                                                     )
  70.                                                   ) ;_ end of vl-remove-if-not
  71.                                 ) ;_ end of car
  72.                               ) ;_ end of assoc
  73.                        ) ;_ end of cdr
  74.             ) ;_ end of setq
  75.     (foreach file_menu (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash server) x)))
  76.                                (vl-directory-files server "*.CUIX" 1)
  77.                                ) ;_ end of mapcar
  78.       ;; Ищем локально файлы.
  79.       (cond ((and (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
  80.                                     (vl-filename-base file_menu)
  81.                                     (vl-filename-extension file_menu)
  82.                                     ) ;_ end of strcat
  83.                             ) ;_ end of findfile
  84.                   (not (member (strcase (vl-filename-base file_menu)) (mapcar 'strcase cur_user)))
  85.                   ) ;_ end of and
  86.              ;; Файл есть и он не среди cur_user, найти элемент меню, выгрузить и удалить файлы
  87.              (if (menugroup (vl-filename-base file_menu))
  88.                (vl-catch-all-apply
  89.                  (function
  90.                    (lambda ()
  91.                      (vla-unload (vla-item (vla-get-menugroups (vlax-get-acad-object)) (vl-filename-base file_menu)))
  92.                      ) ;_ end of lambda
  93.                    ) ;_ end of function
  94.                  ) ;_ end of vl-catch-all-apply
  95.                ) ;_ end of if
  96.              (foreach file (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
  97.                                    (vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
  98.                                    ) ;_ end of mapcar
  99.                (vl-file-delete file)
  100.                ) ;_ end of foreach
  101.              )
  102.             ((and (not (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
  103.                                          (vl-filename-base file_menu)
  104.                                          (vl-filename-extension file_menu)
  105.                                          ) ;_ end of strcat
  106.                                  ) ;_ end of findfile
  107.                        ) ;_ end of not
  108.                   (member (strcase (vl-filename-base file_menu)) (mapcar 'strcase cur_user))
  109.                   ) ;_ end of and
  110.              ;; Файла нет и он среди cur_user, скачать и загрузить
  111.              )
  112.             ((and (findfile (strcat (_kpblc-dir-path-and-splash loc_path)
  113.                                     (vl-filename-base file_menu)
  114.                                     (vl-filename-extension file_menu)
  115.                                     ) ;_ end of strcat
  116.                             ) ;_ end of findfile
  117.                   (or ;; Сравниваем количество файлов указанного меню на сервере и локально. Если неодинакого - обновлять
  118.                       (/= (length
  119.                             (setq loc_lst (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
  120.                                                   (vl-remove-if (function (lambda (x) (member (strcase (vl-filename-extension x)) '(".MNR" ".MNC"))))
  121.                                                                 (vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
  122.                                                                 ) ;_ end of vl-remove-if
  123.                                                   ) ;_ end of mapcar
  124.                                   ) ;_ end of setq
  125.                             ) ;_ end of length
  126.                           (length
  127.                             (setq server_lst (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash server) x)))
  128.                                                      (vl-remove-if (function (lambda (x) (member (strcase (vl-filename-extension x)) '(".MNR" ".MNC"))))
  129.                                                                    (vl-directory-files server (strcat (vl-filename-base file_menu) ".*"))
  130.                                                                    ) ;_ end of vl-remove-if
  131.                                                      ) ;_ end of mapcar
  132.                                   ) ;_ end of setq
  133.                             ) ;_ end of length
  134.                           ) ;_ end of /=
  135.                       ;; Если одинакого и хотя бы один из файлов на сервере новее - обновлять
  136.                       (apply (function or)
  137.                              (mapcar (function (lambda (a b) (< (_kpblc-get-file-date a) (_kpblc-get-file-date b))))
  138.                                      loc_lst
  139.                                      server_lst
  140.                                      ) ;_ end of mapcar
  141.                              ) ;_ end of apply
  142.                       ) ;_ end of or
  143.                   ) ;_ end of and
  144.              ;; выгрузить меню, удалить файлы, скопировать локально и загрузить
  145.              (if (not
  146.                    (vl-catch-all-error-p
  147.                      (vl-catch-all-apply
  148.                        (function
  149.                          (lambda () (vla-unload (vla-get-menugroups (vlax-get-acad-object)) (vl-filename-base file_menu)))
  150.                          ) ;_ end of function
  151.                        ) ;_ end of vl-catch-all-apply
  152.                      ) ;_ end of vl-catch-all-error-p
  153.                    ) ;_ end of not
  154.                (progn (foreach file (mapcar (function (lambda (x) (strcat (_kpblc-dir-path-and-splash loc_path) x)))
  155.                                             (vl-directory-files loc_path (strcat (vl-filename-base file_menu) ".*"))
  156.                                             ) ;_ end of mapcar
  157.                         (vl-file-delete file)
  158.                         ) ;_ end of foreach
  159.                       (foreach file server_lst
  160.                         (vl-file-copy file
  161.                                       (strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file) (vl-filename-extension file))
  162.                                       ) ;_ end of vl-file-copy
  163.                         ) ;_ end of foreach
  164.                       (if (setq cui (cond ((findfile (strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file_menu) ".CUI")))
  165.                                           ((findfile (strcat (_kpblc-dir-path-and-splash loc_path) (vl-filename-base file_menu) ".CUIX")))
  166.                                           ) ;_ end of cond
  167.                                 ) ;_ end of setq
  168.                         ;; Ну и собственно загрузка
  169.                         (command-s "_.menuload" cui)
  170.                         ) ;_ end of if
  171.                       ) ;_ end of progn
  172.                ) ;_ end of if
  173.              )
  174.             ) ;_ end of cond
  175.       ) ;_ end of foreach
  176.     ) ;_ end of if
  177.   ) ;_ end of defun
Постарался в комментария расписать собственную логику.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 745
  • Карма: 111
Совсем забыл! Иногда после (command-s "_.menuload" ...) надо принудительно выводить выпадающее меню (если оно вообще используется).
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!