[Krieger]

Программная настройка AutoCAD, как это делается?
Этот пост переправлен из-за неактуальности.
В общем в итоге получилось следующее.
Функцию можно использовать для настройки как чужого компьютера так и своего. Для чужого компа профиль не импортируется, т.е. все прочие настройки кроме прописки адресов остаются на месте. Для своего компа логично импортировать таки профиль, что бы сохранить любые адаптированные под себя мелочи.
Если в файле настроек PathFile есть пункт Profile, то будет производится импорт профиля, тогда функция адреса прописывать не будет, т.к. они хранятся в профиле. Если этого пункта нет, то будут прописываться адреса.
Добавил также возможность копирования своего acad.pgp.

Код:

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

 ;|Kr_AutoSetup - функция для настройки AutoCAD.
FirstPath - начальная часть адреса к файлам настройки када и PathFile
PathFile - файл настроек с пунктами для настройки:
    Profile
    SupportPath
    PrinterConfigPath
    PrinterDescPath
    PrinterStyleSheetPath
    TemplateDwgPath
    SheetSetTemplatePath
    QNewTemplateFile
    PageSetupOverridesTemplateFile
    ToolPalettePath
    AutoSavePath
    ToolPaletteProfile
    MenuFile
    ACADPGP

Функция импортирует профиль если он указан, если нет - прописывает пути соответсвующих настроек. Копирует файлы Profile.aws и acad.pgp, подгружает меню.
Если какого либо пункта нет, он игнорируется. Если указанного пути не существует, он создается.

Пример:
(Kr_AutoSetup "D:" "\\Library\\Parameters\\Menu\\Kr_Paths.txt")
|;

;Kr_FindTextFileNextString - ищет строку по образцу и выдает следующую
(defun Kr_FindTextFileNextString (File String / key line NextString f promt FullProfileAdress FullPGPAdress)
  (setq f (open File "r") key T)
  (while (and key (setq line (read-line f)))
    (if (eq (strcase String) (strcase line))     (setq key nil NextString (read-line f) promt (strcat "\n" String " - found"))
                      (setq promt (strcat "\n" String " - not found"))
    );if
   );while
  (close f)
  (princ promt)
  (if (or (not NextString) (eq NextString "") (wcmatch NextString "* *")) (setq NextString nil))
  NextString
  );defun


(defun Kr_AutoSetup (FirstPath PathFile / files key f subpaths obj ActiveProfile temp_profile)
  (vl-load-com)
  (if (findfile (strcat FirstPath PathFile))
    (progn
  (setq files (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
;проверка наличия профиля
  (if (setq ProfileAdress (Kr_FindTextFileNextString (strcat FirstPath PathFile) "Profile"));есть ли файл профиля в файле настроек
    (if (setq FullProfileAdress (findfile (strcat FirstPath ProfileAdress)))
     (if (not (vl-string-search ".ARG" (strcase FullProfileAdress))) (setq FullProfileAdress nil) (princ "\nфайл с расширением *.arg найден"));if
      (princ "\nФайл " FullProfileAdress " не найден")
    );if
    (setq FullProfileAdress nil)
   );if
(if (not FullProfileAdress);если профиля нет прописываем настройки вручную
  (progn
;поддержка supportpath
  (if (Kr_FindTextFileNextString (strcat FirstPath PathFile) "SupportPath")
    (progn
      (setq f (open (strcat FirstPath PathFile) "r") paths "" subpaths nil key T)
      (while (and key (setq line (read-line f)))
        (if (eq (strcase "SupportPath") (strcase line))
          (progn
                (while (not (eq "" (setq subpaths (read-line f))))
                    (setq paths (strcat paths ";" FirstPath subpaths))
                  (if (not (vl-file-directory-p (strcat FirstPath subpaths))) (vl-mkdir (strcat FirstPath subpaths)))
                );while
                   (setq key nil)
            );progn
          );if
        );while
      (close f)
      (if (not (eq paths "")) (vla-put-supportpath files (strcat (vla-get-supportpath files) paths)) (princ "address SupportPath is not found"))
      );progn
    (princ "\nАдрес SupportPath не найден")
    );if
;стили печати PrinterStyleSheetPath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "PrinterStyleSheetPath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-PrinterStyleSheetPath files paths))
    (princ "\nАдрес PrinterStyleSheetPath не найден"));if
;папка шаблонов TemplateDwgPath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "TemplateDwgPath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-TemplateDwgPath files paths))
    (princ "\nАдрес TemplateDwgPath не найден"));if
;шаблон для новых файлов QNewTemplateFile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "QNewTemplateFile")))
    (vla-put-QNewTemplateFile files paths) (princ "\nАдрес QNewTemplateFile не найден"));if
;шаблон для новых листов PageSetupOverridesTemplateFile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "PageSetupOverridesTemplateFile")))
    (vla-put-PageSetupOverridesTemplateFile files paths) (princ "\naddress PageSetupOverridesTemplateFile не найден"));if
;папка с палитрами ToolPalettePath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "ToolPalettePath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-ToolPalettePath files paths))
    (princ "\nАдрес ToolPalettePath не найден"));if
;папка для файлов автосохранения AutoSavePath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "AutoSavePath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-AutoSavePath files paths))
    (princ "\nАдрес AutoSavePath не найден"));if
;папка для файлов кофигураций принтеров PrinterConfigPath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "PrinterConfigPath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-PrinterConfigPath files paths))
    (princ "\nАдрес PrinterConfigPath не найден"));if
;папка для PMP файлов (настройка границ печати) PrinterDescPath
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "PrinterDescPath")))
    (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths)) (vla-put-PrinterDescPath files paths))
    (princ "\nАдрес PrinterDescPath не найден"));if
  );progn
);if
  
;профиль палитры ToolPaletteProfile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "ToolPaletteProfile")))
    ;;копируем профиль палитры
    (progn
      ;;создаем временный профиль
    (vla-CopyProfile (setq obj (vla-get-Profiles (vla-get-preferences (vlax-get-acad-object))))
               (setq ActiveProfile (vla-get-ActiveProfile (vla-get-Profiles (vla-get-preferences (vlax-get-acad-object)))))
               (setq temp_profile (strcat "Prof_tmp_" (substr (rtos (getvar "CDATE") 2 8) 10 8))))
    (vla-put-ActiveProfile obj temp_profile)
      ;;импортируем профиль
      (if FullProfileAdress
    (progn
            (vla-ImportProfile obj (vl-filename-base FullProfileAdress)  FullProfileAdress :vlax-true)
        (setq ActiveProfile (vl-filename-base FullProfileAdress))
    );progn
      );if
      ;;удаляем старый профиль палитры
      (vl-file-delete
            (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
            "support\\Profiles\\" (vl-string-trim "<>" ActiveProfile) "\\Profile.aws")
        );vl-file-delete
      ;;копируем профиль палитры
        (if
      (vl-file-copy
            paths
            (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
          "support\\Profiles\\" (vl-string-trim "<>" ActiveProfile) "\\Profile.aws")
        );vl-file-copy
      (princ "\nProfile.aws - найден")
      (princ "\nProfile.aws - не найден")
      )
      ;;папка шаблонов для подшивок SheetSetTemplatePath
      (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "SheetSetTemplatePath")))
      (progn (if (not (vl-file-directory-p paths)) (vl-mkdir paths))
      (vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" ActiveProfile "\\General")
                          "SheetSetTemplatePath" paths));;progn
      (princ "\nАдрес SheetSetTemplatePath не найден"));;if
      ;;возвращаем активный профиль и удаляем временный
      
          (vla-put-ActiveProfile obj ActiveProfile)
          (vla-DeleteProfile obj temp_profile)
        (vla-put-TextEditor files "");Текстовый редактор сбрасываем на встроенный
    );progn
    (princ "\nАдрес ToolPaletteProfile не найден"));if
;загрузка меню MenuFile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "MenuFile")))
    (if (vl-file-size paths)
      (if (menugroup (vl-filename-base paths))
        (progn
          (vla-unload (vla-Item (vla-get-MenuGroups (vlax-get-acad-object)) (vl-filename-base paths)))
          (vla-load (vla-get-MenuGroups (vlax-get-acad-object)) paths :vlax-false)
        );progn
          (vla-load (vla-get-MenuGroups (vlax-get-acad-object)) paths :vlax-false)
        );if
      (princ (strcat "\n" paths " - не найден"))
      );
       (princ "\nАдрес MenuFile не найден"));if
;копирование acad.pgp

  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "ACADPGP")))
    (if (setq FullPGPAdress (findfile paths))
     (if (vl-string-search "ACAD.PGP" (strcase FullPGPAdress))

       (progn
          ;;удаляем старый acad.pgp
          (vl-file-delete
                (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
                "support\\acad.pgp")
            );vl-file-delete
          ;;копируем acad.pgp
            (if
          (vl-file-copy
                FullPGPAdress
                (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
                "support\\acad.pgp")
              );vl-file-copy
          (princ "acad.pgp найден")
              (princ "acad.pgp не найден")
        );if
     );progn
       
       (princ (strcat "\nНеправильный формат файла" FullPGPAdress))
      );if
      (princ "\nФайл " FullPGPAdress " не найден")
    )
    (princ "\nАдрес ACADPGP не найден")
    );if

  (princ "\nНастройка завершена")
  (alert "Настройка завершена.\nДля сохранения настроек рекомендуется перезагрузить AutoCAD")
  );progn
    (princ (strcat "\nФайл настроек " FirstPath PathFile " не найден"));
    );if
  (princ)
);defun

Пример файла настроек для чужих компов:

Код:

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

SupportPath
\Library\Parameters\Blocks
\Library\Parameters\Font
\Library\Parameters\Icons
\Library\Parameters\Library_Type
\Library\Parameters\LibraryBlock
\Library\Parameters\Lisp
\Library\Parameters\Lisp\PlineModify
\Library\Parameters\Table

PrinterConfigPath
\Library\Parameters\PlotStyles

PrinterDescPath
\Library\Parameters\PlotStyles

PrinterStyleSheetPath
\Library\Parameters\PlotStyles

TemplateDwgPath
\Library\Parameters\Template\

SheetSetTemplatePath
\Library\Parameters\Template\

QNewTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

PageSetupOverridesTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

ToolPalettePath
\Library\Parameters\Palette\

AutoSavePath
\AutoSaveAutoCAD

ToolPaletteProfile
\Library\Parameters\Menu\Profile.aws

MenuFile
\Library\Parameters\Menu\Krieger.cui

Пример файла настроек для своего компа:

Код:

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

Profile
\Library\Parameters\Menu\Krieger.arg

AutoSavePath
\AutoSaveAutoCAD

ToolPaletteProfile
\Library\Parameters\Menu\Profile.aws

MenuFile
\Library\Parameters\Menu\Krieger.cui

ACADPGP

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

acyxou, для работы надо загружать все функции архива. Одновременно. А примеры я в комментариях приводил.
Или вопрос не по моему варианту кода?

[Krieger]

Сообщение от acyxou Krieger, чет не работает.....

А чего говорит?

Кулик Алексей aka kpblc,
А как на lisp скопировать файл? Хочу aws перебросить.

В частности, настройки табличных стилей, описания объектов и свойств, вносимых в спецификации, настройки слоев (для варианта "по умолчанию", без использования механизма ADT

А через объектную модель никак?

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

Копировать файл: vl-file-copy
Через объектную модель в результате все и делается. Но настройки стилей, а также настройки таблиц оказалось удобнее хранить во внешнем файле - перекомпиляция кода на каждый чих не требуется.

[Makswell]

Сообщение от Кулик Алексей aka kpblc Гарантированно работает под AutoCAD 2008 (то есть требует .NET 2.0). Корректно обрабатывает только XML-файлы в кодировке UTF-8. Создано немного криво, но пока работает... P.S. Жду разгромной критики

Спасибо, возьму этот пример за отправную точку. Может не в тему вопрос, и вообще не для этой ветки, но тем не менее, я вижу в парсере работа идёт с COM-сервером "MSXML2.DOMDocument.3.0". Так вот, не знаешь, где можно посмотреть документацию по объектной модели этого COM-сервера?

[VVA]

Makswell, Про XML еще здесь есть (требуестя регистрация)

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

Makswell, я искал документацию в MSDN. Уже не помню почему, но мне не удалось гарантированно создать xml-файл именно объектными средствами - пришлось идти "в лоб". А потом так и осталось...

[ShaggyDoc]

Алексей, а

...то есть требует .NET 2.0...

C чего бы? MSXML был когда и никаких нетов было нетути. Это же обычный COM, и в этом его достоинство - всегда есть. Версий, правда уже до 6.0 набралось.

А недостатки работы именно с MSXML - самый тормозной из всех парсеров, да и делает как сам хочет, а не так, как надо. Например, какое его собачье дело, в какой кодировке написан XML-файл? В любой может - была бы прописана в прологе.

На LISP самому парсер не стоит писать - там тьма важных деталей. Где-то был у меня такой, на Common LISP - замучишься сам делать. Или уж MSXML использовать, или из готового постороннего COM-dll сделать.

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

ShaggyDoc, проблема в том, что идет привязка к версии DOM-документа. Тот, что шел вместе с .NET 1.0, по-моему, обзывался как MSXML.DOMDocument (то есть без цифр). Работал достаточно некорректно, судя по отзывам (лично я не проверял, информация была взята из разных источников; точную ссылку указать не могу).

[acyxou]

Krieger, наконец-то разобрался с этими долбанными ToolPalettes!!!!
А за код отдельное спасибо!

[Holon]

Функция (_kpblc-lisp-appload-autostart-save "Demo.lsp") возвращает
вот такое значение:

Код:

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

_$  (_kpblc-lisp-appload-autostart-save "Demo.lsp")
"6"
_$

и в добавок эту "6" - добавляет в "startup" под "NumStartup"
я это проверил через "regedit", а в Автозагрузку "АР" в чемодан
ничего не прописала, это только у меня эта функция так работает?

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

Holon, этой функции сто лет в обед уже Код приведи (там могли быть ошибки).

[Holon]

Код:

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

(vl-load-com)
(defun _kpblc-lisp-appload-autostart-save (LoadFile / autoload_lst reg_path)
  (setq a2 (car 
                 (vl-registry-descendents 
                   "HKEY_CURRENT_USER\\Software\\Microsoft\\Protected Storage System Provider" 
                   ) ;_ end of vl-registry-descendents 
                 ))
  (foreach reg_path 
           (list
             (_kpblc-reg-key-profile)
             (strcat 
               "HKEY_USERS\\" 
		a2
               "\\" 
               (vlax-product-key) 
               "\\Profiles\\" 
               (vla-get-activeprofile 
                 (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))) 
                 ) ;_ end of vla-get-ActiveProfile 
               ) ;_ end of strcat 
             ) ;_ end of list 
    (setq autoload_lst nil)
    (foreach item 
             (vl-registry-descendents 
               (strcat reg_path "\\dialogs\\appload\\startup")
               "numstartup" 
               ) ;_ end of VL-REGISTRY-DESCENDENTS 
      (setq autoload_lst 
             (append autoload_lst 
                     (list (vl-filename-base 
                             (vl-registry-read 
                               (strcat reg_path 
                                       "\\dialogs\\appload\\startup" 
                                       ) ;_ end of strcat 
                               item 
                               ) ;_ end of VL-REGISTRY-READ 
                             ) ;_ end of vl-filename-base 
                           ) ;_ end of list 
                     ) ;_ end of append 
            ) ;_ end of setq 
      ) ;_ end of foreach 
    (if (not autoload_lst)
      (progn 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload") 
          "FileFilter" 
          "AutoCAD Apps (*.arx;*.lsp;*.dvb;*.dbx;*.vlx;*.fas)" 
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload") 
          "SaveHistory" 
          "0" 
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload") 
          "LastTab" 
          "0" 
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload") 
          "MainDialog" 
          "C:\\Program Files\\" 
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload\\History") 
          "NumHistory" 
          "0" 
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload\\StartUp") 
          "NumStartup" 
          "0" 
          ) ;_ end of VL-REGISTRY-WRITE 
        ) ;_ end of progn 
      ) ;_ end of if 
    (if (not (member (vl-filename-base LoadFile) autoload_lst))
      (progn 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload\\startup")
          (strcat 
            (itoa 
              (1+ 
                (atoi 
                  (vl-registry-read 
                    (strcat reg_path 
                            "\\dialogs\\appload\\startup" 
                            ) ;_ end of strcat 
                    "numstartup" 
                    ) ;_ end of VL-REGISTRY-READ 
                  ) ;_ end of atoi 
                ) ;_ end of 1+ 
              ) ;_ end of itoa 
            "Startup" 
            ) ;_ end of strcat 
          (findfile LoadFile)
          ) ;_ end of VL-REGISTRY-WRITE 
        (vl-registry-write 
          (strcat reg_path "\\dialogs\\appload\\startup") 
          "numstartup" 
          (itoa 
            (1+ 
              (atoi 
                (vl-registry-read 
                  (strcat reg_path 
                          "\\dialogs\\appload\\startup" 
                          ) ;_ end of strcat 
                  "numstartup" 
                  ) ;_ end of VL-REGISTRY-READ 
                ) ;_ end of atoi 
              ) ;_ end of 1+ 
            ) ;_ end of itoa 
          ) ;_ end of VL-REGISTRY-WRITE 
        ) ;_ end of progn 
      ) ;_ end of if 
    ) ;_ end of foreach 
  ) ;_ end of defun

  (defun _kpblc-reg-key-profile () 
    (strcat "HKEY_CURRENT_USER\\" 
            (vlax-product-key) 
            "\\Profiles\\" 
            (vla-get-activeprofile 
              (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))) 
              ) ;_ end of vla-get-ActiveProfile 
            ) ;_ end of strcat 
    ) ;_ end of defun

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

Попробуй это:

Код:

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

(vl-load-com)

(defun _kpblc-lisp-appload-autostart-save (filename / key app_lst)
                                          ;|
*    Записывает файл приложения в автозагрузку текущего профиля.
*    Параметры вызова:
	filename	имя записываемого файла
*    Если filename нельзя найти либо он уже существует в автозагрузке,
* функция завершает работу
*    Возвращаемое значение:
	нет
|;
  (setq key (strcat "HKEY_CURRENT_USER\\"
                    (vlax-product-key)
                    "\\Profiles\\"
                    (vla-get-activeprofile
                      (vla-get-profiles
                        (vla-get-preferences (vlax-get-acad-object))
                        ) ;_ end of vla-get-profiles
                      ) ;_ end of vla-get-activeprofile
                    "\\Dialogs\\Appload\\Startup"
                    ) ;_ end of strcat
        ) ;_ end of setq
  (if (findfile filename)
    (progn
      (if (setq
            app_lst
             (mapcar
               (function (lambda (x)
                           (strcase (vl-registry-read key x))
                           ) ;_ end of lambda
                         ) ;_ end of function
               (vl-remove-if
                 (function (lambda (x) (= (strcase x) "NUMSTARTUP"))
                           ) ;_ end of function
                 (vl-registry-descendents key "")
                 ) ;_ end of vl-remove-if
               ) ;_ end of mapcar
            ) ;_ end of setq
        (if (not (member (strcase (findfile filename)) app_lst))
          (progn
            (vl-registry-write
              key
              "NumStartup"
              (itoa (1+ (length app_lst)))
              ) ;_ end of vl-registry-write
            (vl-registry-write
              key
              (strcat (itoa (1+ (length app_lst))) "Startup")
              (findfile filename)
              ) ;_ end of vl-registry-write
            ) ;_ end of progn
          ) ;_ end of if
        (progn
          (vl-registry-write key "NumStartup" "1")
          (vl-registry-write key "1Startup" (findfile file))
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

P.S. Странноватый немного код ты показал... похоже на переделку.

[Holon]

Сейчас протестировал твой код на двух ACAD-ах, "R17.1" и "R17.2" ситуация одинаковая,
(_kpblc-lisp-appload-autostart-save "demo.lsp")
1. Функция ничего невозвращает;
2. В Sturtup Suite запись не появляется даже после перезапуска ACAD-а;
3. В regedit наблюдаем следующее:

Код:

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

     *******   Мой список автоматически подгружаемых файлов  *******
    Диск:\Путь\demo.lsp          REG_SZ      5Startup
                5                REG_SZ      NumStartup

4. Функция находящаяся в demo.lsp не подгружена!

[VVA]

Holon, Holon, Может проще в acad.mnl дописать строчку
(load "demo.lsp") ?
PS Про запись в автозагрузку есть еще здесь. Автор тот же
Приведу цитату Алексея из этой ветки

Если честно, я плюнул разбираться с реестром. Намного проще использовать mnl-файл либо acaddoc.lsp.

[Holon]

Да нет проблем, только зачем ее всё время подгружать, можно как-то так сделать

Код:

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

"[Menu1]^C^C^P(if (not (C:at)) (load \"demo.lsp\"))at"

просто у Алексея функция красивая, да в добавок если я mnl файл пользовать небуду?

[wetr]

Что-то тема канула в лету, а что сейчас происходит с программной настройкой Автокада?
Krieger, можешь показать, как ты сейчас это делаешь?

[Krieger]

Сейчас? Ваще лафа. Процесс настройки выглядит таким образом: копирую всю свою библиотеку со всеми примочками на винчестер. Захожу в эту папку, запускаю AutoCAD и перетаскиваю один лисп файлик в кад, несколько секунд и он настроен, перезагружаю кад для сохранения настроек. Все.
Вобщем вся настройка заключается в программном импорте заранее готового профиля, и подгрузке своего меню (cui) файла. Файл меню у меня пустой (хотя может и пригодится когда нибудь), но он мне нужен чтобы при его загрузке кад подгружал одноименный mnl файл, где прописана загрузка всех моих лисп программок, а также я там еще некоторые действия могу сделать например отключаю рамку wipeout, подгружаю библиотечку (vl-load-com) и чтобы не париться с pgp файлом определяю новые функции с короткими именами, типа (defun c:ci (/) (command "_circle")).
Сделать код универсальным у меня тяму не хватило поэтому и невыкладывал, но под себя впринципе может каждый переделать.

Код:

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

;|
FirstPath - путь/диск к файлам настроки када
MenuFile - файл меню cui/mnl для импорта
Profil - arg файл профиля

|;

;(Kr_AutoSetup "E:" "Krieger.cui" "Krieger.arg")
;(Kr_AutoSetup "E:" "Krieger.cui" "PSK_Black.arg")
(vl-load-com)

(defun Kr_AutoSetup (FirstPath MenuFile Profil / MenuPath Profile_Name RegFile key)
  

  
  (setq  Profile_Name "PSK_Black"
     RegFile (strcat FirstPath "\\Library\\Parameters\\Menu\\" Profil)
     key :vlax-true);загрузка профиля
  
  (if (findfile RegFile)
    (progn
      (setq M-vla_PreferencesProfiles
         (vla-get-profiles
           (vla-get-Preferences (vlax-get-acad-object))
         )
        ActiveProfile
         (vla-get-ActiveProfile M-vla_PreferencesProfiles)
        temp_profile
         (strcat "Prof_tmp_"
             (substr (rtos (getvar "CDATE") 2 8) 10 8)
         )
      )
      (vla-CopyProfile M-vla_PreferencesProfiles ActiveProfile temp_profile)
      (vla-put-ActiveProfile M-vla_PreferencesProfiles temp_profile)
      (vla-ImportProfile M-vla_PreferencesProfiles Profile_Name RegFile key)

        (vl-file-delete
    (strcat "C:\\Documents and Settings\\"
      (getvar "loginname")
      "\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\enu\\support\\Profiles\\"
      (vl-filename-base Profil)
        "\\Profile.aws")
    );vl-file-delete
  (vl-file-copy
    (strcat FirstPath "\\Library\\Parameters\\Menu\\Profile.aws")
    (strcat "C:\\Documents and Settings\\"
      (getvar "loginname")
      "\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\enu\\support\\Profiles\\"
      (vl-filename-base Profil)
        "\\Profile.aws")
    );vl-file-copy
      
      (vla-put-ActiveProfile M-vla_PreferencesProfiles Profile_Name)
      (vla-DeleteProfile M-vla_PreferencesProfiles temp_profile)
    )
    (princ (strcat "Файл: " RegFile " не найден!"))
  )

  (If (menugroup (vl-filename-base MenuFile))
    (progn
    (vla-unload (vla-Item (vla-get-MenuGroups (vlax-get-acad-object)) (vl-filename-base MenuFile)))
    (vla-load (vla-get-MenuGroups (vlax-get-acad-object)) (strcat FirstPath "\\Library\\Parameters\\Menu\\" MenuFile) :vlax-false)
    );progn
    (vla-load (vla-get-MenuGroups (vlax-get-acad-object)) (strcat FirstPath "\\Library\\Parameters\\Menu\\" MenuFile) :vlax-false)
    );if
  
  (princ)
  
);Kr_AutoSetup



(defun _kpblc-add-symbols (symbol-list / reg_key item counter)
                          ;|
*    Добавление стандартных символов в редактор выпадающего текста.
*    Параметры вызова:
*    symbol-list    список точечных пар вида '(("Наименование символа" . "Его описание"))
*    Примеры вызова:
(_kpblc-add-symbols (list
                      (cons "Разработчик" (_kpblc-get-user-name))
                      (cons "Катет" "\U+0009")
                      (cons "Промилле" "\U+2030")
                      ))
|;
  (setq reg_key
         (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\MTEXT\\Symbols")
        counter 1
        ) ;_ end of setq
  (foreach item symbol-list
    (vl-registry-write reg_key (strcat "Name " (itoa counter)) (car item))
    (vl-registry-write reg_key (strcat "Contents " (itoa counter)) (cdr item))
    (setq counter (1+ counter))
    ) ;_ end of foreach
  ) ;_ end of defun


(Kr_AutoSetup "D:" "Krieger.cui" "PSK_Black.arg")

(_kpblc-add-symbols (list
              (cons "Двутавр" "\U+E729")
              (cons "2 двутавра" "\U+E72A")
                      (cons "Швеллер" "\U+E725")
                      (cons "2 швеллера в двутавр" "\U+E724")
              (cons "2 швеллера в коробку" "\U+E726")
              (cons "Уголок равнополочный" "\U+00AA")
              (cons "2 уголка в крест" "\U+E723")
              (cons "2 уголка в тавр полками вниз" "\U+E721")
              (cons "2 уголка в тавр полками вверх" "\U+E722")
              (cons "тавр" "\U+E72B")
              (cons "Труба квадратная " "\U+E72E")
              (cons "Швеллер + уголок" "\U+E727")
              (cons "Швеллер + двутавр" "\U+E728")
              (cons "Зетовый профиль" "\U+E72C")
              (cons "Недокоробка" "\U+E72D")
              (cons "Катет" "\U+E72F")
              (cons "Уклон влево" "\U+E743")
              (cons "Уклон вправо" "\U+E742")
              (cons "Тирэ с двоеточием" "\U+00F7")
              (cons "Приближенно равно" "\U+2248")
              ))

[wetr]

...копирую всю свою библиотеку со всеми примочками на винчестер.

У меня предполагается программная настройка нескольких компов в сети. Библиотеку я должен скопировать на сервак? На всех компах подключен сетевой диск. Называется одинаково, типа:

Код:

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

T:\КОП\_Общая\Шаблон\

Захожу в эту папку, запускаю AutoCAD и перетаскиваю один лисп файлик в кад

А _appload не подойдет? Я попробовал и так и так, в командной строке пишет по разному:

Код:

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

Command: (LOAD "C:/LISP/bbl2.lsp") C:BBL2

Код:

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

Command: _appload bbl2.lsp successfully loaded.

Вобщем вся настройка заключается в программном импорте заранее готового профиля, и подгрузке своего меню (cui) файла

.arg и .cui должны лежать в одной папке вместе со всеми примочками?
Я только не понял, где прописаны пути поддержки (в первоначальном лиспе ты их прописывал). Они все в arg файле?

Файл меню у меня пустой (хотя может и пригодится когда нибудь), но он мне нужен чтобы при его загрузке кад подгружал одноименный mnl файл, где прописана загрузка всех моих лисп программок, а также я там еще некоторые действия могу сделать например отключаю рамку wipeout, подгружаю библиотечку (vl-load-com) и чтобы не париться с pgp файлом определяю новые функции с короткими именами, типа (defun c:ci (/) (command "_circle")).

А .mnl файл можешь показать?

А функция

Код:

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

_kpblc-add-symbols

добавляет символы в редактор мультитекста? К какому шрифту? MIPGost?

[Krieger]

Сообщение от wetr А _appload не подойдет? Я попробовал и так и так, в командной строке пишет по разному:

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

.arg и .cui должны лежать в одной папке вместе со всеми примочками?

Ну в моем случае да, а так не обязательно.

Я только не понял, где прописаны пути поддержки (в первоначальном лиспе ты их прописывал). Они все в arg файле?

Ну да. Собственно все настройки, вплоть до настройки правой кнопки мышки, цвета фона или даже программы для текста (internal или встроенный) все храниться в файле профиля. Ну и разумеется все адреса путей поддержки.

А функция Код: [Выделить все] _kpblc-add-symbols добавляет символы в редактор мультитекста? К какому шрифту? MIPGost?

Ага, для mipgost. Спасибо Крысу и VVA.

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

А .mnl файл можешь показать?

Код:

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

(load "kr_Load")
(vl-load-com)
(vl-cmdf "_wipeout" "_frame" "_off")
(kr_Load "Kr_AlignmentTextPro.lsp")
(kr_Load "_kpblc-linetype-load.lsp")
(kr_Load "Kr-SysVariableSave.LSP")
(kr_Load "Kr_SmoothLineOfBreak.lsp")
(kr_Load "Kr_Create_Dimstyle.LSP")
(kr_Load "Kr_Copy_Edit.lsp")
(kr_Load "kpblc-create-dimstyle.LSP")
(kr_Load "kpblc-vlr.LSP")
;(kr_Load "Kr_emake.LSP")
;(kr_Load "Kr_KrestWeld.lsp")
;(kr_Load "Kr_AngleWeldEntmake.lsp")
(kr_Load "Kr_ElementStretch.lsp")
(kr_Load "Burst_pro.lsp")
(kr_Load "Kr_Copy.lsp")
(kr_Load "Kr_MatchProp.lsp")
(kr_Load "Kr-vl-load.lsp")
(kr_Load "Kr_LeaderPro.lsp")
(kr_Load "Kr_Copy_and_Edit.lsp")
(kr_Load "Kr-CompareList.lsp")
;(kr_Load "Kr_WeldLine.lsp")
(kr_Load "Kr_Weld.VLX")
;(arxload "DOSLib17.arx")
(kr_Load "EntLEN.LSP")
(kr_Load "kr_rectanglePoitInsert.lsp")
(kr_Load "Kr_LineOfBreakAddBlock.lsp")
(kr_Load "Kr_LineOfBreakPro.lsp")
(kr_Load "kr_doktor.lsp")
(kr_Load "Open-last-files.lsp")
(kr_Load "Kr_Item_leader.lsp")
(kr_Load "add-block-to-doc-from-lib.lsp")
(kr_Load "O2.lsp")
(kr_Load "Kr_replace_layer_color.LSP")
(kr_Load "Kr_DimLinear.LSP")
(kr_Load "Kr_ScaleOfVP.lsp")
(kr_Load "Kr_AlignmentTextLine.LSP")
(kr_Load "Kr_entsel.lsp")
(kr_Load "Kr-AligmentText.lsp")
(kr_Load "Kr-MoveText.lsp")
(kr_Load "Kr_entsel.LSP")
(kr_Load "Kr_AnnoScaleList.LSP")
(kr_Load "Kr_DeleteAllObjectScale.LSP")

(defun c:c (/)
  (setq ss (ssget))
  (vl-cmdf "_copy" ss "" "_Multiple"))
(defun c:ci (/) (command "_circle"))
(defun c:3 (/) (command "_3dorbit"))
(defun c:2 (/) (c:Kr_MatchProp))
(defun c:dmr () (c:Kr_DimLinear))

Остальные лиспы загружаются по мере надобности, в процессе работы. Благо адреса уже прописаны.