| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Программная настройка AutoCAD, как это делается?

Программная настройка AutoCAD, как это делается?

Ответ
Поиск в этой теме
Непрочитано 23.01.2009, 16:34 2 |
Программная настройка AutoCAD, как это делается?
Krieger
 
инженер (КМ)
 
Красноярск
Регистрация: 30.10.2004
Сообщений: 3,825

Программная настройка 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
__________________
Делай хорошо, плохо само получится.

Последний раз редактировалось Krieger, 02.02.2012 в 14:35. Причина: Что в итоге получилось
Просмотров: 75268
 
Автор темы   Непрочитано 16.09.2009, 15:36
#61
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Я уважаю. Я же говорю что перешли те, кому "до лампочки". Кто не захотел переходить, тот так и продолжает работать.
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 17.09.2009, 01:31
#62
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от acyxou Посмотреть сообщение
но сейчас всегда стараюсь учитывать их интересы и желания
И это правильно!

Цитата:
Сообщение от acyxou Посмотреть сообщение
Я тоже столкнулся с проблемой подстройки профиля под нужды юзера. Вот что они себе меняют:Цвет фона
Настройки правой кнопки миши
Некоторые хотят чтоб в заголовке окна выводилось полное имя файла включая путь
Размеры перекрестия (некоторые любят чтоб крестик был на весь экран)
Некоторые настраивают перекрестие так чтоб он не менял свой вид во время активирования какой-либо команды
Но это опять же частный случай. Настроек может быть очень много
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 17.09.2009, 09:41
#63
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Тогда надо соединить первый код в первом постинге, копирование палитры и загрузку cui с mnl. Только надо разобраться где хранятся остальные необходимые пути.
Хорошо бы тогда составить четкий список чего нужно то настраивать.
1. Добавить пути поддержки "Support File Search Path"
2. Изменить папку со стилями печати Printer Support File Path ->Plot Style Table Search Path
3. Изменить все подпункты для шаблона Template Settings
4. Изменить адрес до палитры инструментов Tool Palettes File Locations
5. Скопировать профиль палитры в соответсвующую папку.
6. Загрузить своё меню.

Что еще?
__________________
Делай хорошо, плохо само получится.

Последний раз редактировалось Krieger, 17.09.2009 в 10:21.
Krieger вне форума  
 
Непрочитано 17.09.2009, 09:58
#64
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


7. Установить необходимые палитры текущими?
8. Еще лиспы загрузить и добавить в автозагрузку.
Стили будут храниться в шаблоне.
Слои тоже можно самые основные. Остальные слои создавать программно.
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 17.09.2009, 10:24
#65
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Цитата:
Сообщение от wetr Посмотреть сообщение
7. Установить необходимые палитры текущими?
За это отвечает профиль палитры, п. 5.

Цитата:
8. Еще лиспы загрузить и добавить в автозагрузку.
За это отвечает mnl подгружаемый с cui.

Цитата:
Стили будут храниться в шаблоне.
Слои тоже можно самые основные. Остальные слои создавать программно.
Все остатальное в шаблоне или программно в процессе работы.


Ну вот, наваял без импорта профиля, т.е. все настройки профиля будут нетронуты, окромя выше перечисленных
Код:
[Выделить все]
;|(Kr_LoadSupportPaths)
;(Kr_LoadSupportPaths "D:" "\\Library\\Parameters\\Kr_Paths.txt" "Krieger.cui")
(setq     disk "D:"
    PathFile "\\Library\\Parameters\\Kr_Paths.txt")
|;
(defun Kr_LoadSupportPaths (disk PathFile MenuFile / files f subpaths) 
  (vl-load-com)
  (setq files (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
;_________________________
;поддержка supportpath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" subpaths nil key T)
  (while (and key (setq line (read-line f)))
    (if (eq "SupportPath" line)
      (progn
            (while (not (eq "" (setq subpaths (read-line f))))
                (setq paths (strcat paths ";" disk subpaths))
            );while
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths ""))
    (vla-put-supportpath files (strcat (vla-get-supportpath files) paths)))
;_________________________
;стили печати PrinterStyleSheetPath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "PrinterStyleSheetPath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-PrinterStyleSheetPath files paths))
;_________________________
;папка шаблонов TemplateDwgPath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "TemplateDwgPath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-TemplateDwgPath files paths))
;_________________________
;шаблон для новых файлов QNewTemplateFile
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "QNewTemplateFile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-QNewTemplateFile files paths))
;_________________________
;шаблон для новых листов PageSetupOverridesTemplateFile
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "PageSetupOverridesTemplateFile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-PageSetupOverridesTemplateFile files paths))
;_________________________
;папка с палитрами ToolPalettePath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "ToolPalettePath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-ToolPalettePath files paths))
;_________________________
;создаем временный профиль
(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) 
;_________________________
;копируем профиль палитры
  ;(vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
  (vl-file-delete
    (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
        "support\\Profiles\\"
      ActiveProfile
        "\\Profile.aws")
    );vl-file-delete
  (vl-file-copy
    (strcat disk "\\Library\\Parameters\\Menu\\Profile.aws")
    (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
        "support\\Profiles\\"
      ActiveProfile
        "\\Profile.aws")
    );vl-file-copy
;_________________________
;удаляем временный профиль
      (vla-put-ActiveProfile obj ActiveProfile)
      (vla-DeleteProfile obj temp_profile)
;_________________________
; загружаем меню
    
  (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 disk "\\Library\\Parameters\\Menu\\" MenuFile) :vlax-false)
    );progn
      (vla-load (vla-get-MenuGroups (vlax-get-acad-object)) (strcat disk "\\Library\\Parameters\\Menu\\" MenuFile) :vlax-false)
    );if
  
  (princ)
);defun
__________________
Делай хорошо, плохо само получится.

Последний раз редактировалось Krieger, 17.09.2009 в 16:34.
Krieger вне форума  
 
Непрочитано 18.09.2009, 02:46
#66
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Ну нипанятна!

Подскажи пример вызова плиз.
Пытаюсь:
Код:
[Выделить все]
(Kr_LoadSupportPaths "T:" "T:\\КОП\\ПГС\\ACAD 2009 settings\\CUI\\Kr_Paths.txt" "myCUI.cui")
Нифига не выходит(

Цитата:
; error: no function definition: WXXY
и кто такой wxXy?
а почему строки
Код:
[Выделить все]
(setq     disk "D:"
    PathFile "\\Library\\Parameters\\Kr_Paths.txt")
закомментированы?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)

Последний раз редактировалось wetr, 18.09.2009 в 03:50.
wetr вне форума  
 
Автор темы   Непрочитано 18.09.2009, 06:17
#67
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Так, извиняюсь, забыл пример Kr_Paths.txt дать. Перед списком с адресами есть заголовки, например SupportPath или TemplateDwgPath. Они должны быть обязательно. Программа ищет эти заголовки и соответствующий адрес вписывает в соответствующую настройку када, т.е. теперь они могут идти в любом порядке и даже отсутствовать ненужные.
Код:
[Выделить все]
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

PrinterStyleSheetPath
\Library\Parameters\PlotStyles

TemplateDwgPath
\Library\Parameters\Template\

QNewTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

PageSetupOverridesTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

ToolPalettePath
\Library\Parameters\Palette\
Цитата:
Сообщение от wetr Посмотреть сообщение
Ну нипанятна!

Подскажи пример вызова плиз.
Пример в коде есть:
Код:
[Выделить все]
(Kr_LoadSupportPaths "D:" "\\Library\\Parameters\\Kr_Paths.txt" "Krieger.cui")
Цитата:
и кто такой wxXy?

Не знаю, где ты такое откопал. Ты код редатировал под себя? Может не нароком какую скобку упустил?
Цитата:
а почему строки
закомментированы?
Потому что не нужны, это для отладки, чтобы функцию полностью не запускать а переменные определить.
Ну и конечно везде где встречается в коде мои адреса типа
\\Library\\Parameters\\Menu\\ - нужно на свои переделать.

Думаю, наверное надо в Kr_Paths.txt еще два адреса добавить с расположением меню и Profile.aws, для пущей универсальности.

_______________________________
Добавлено:

Добавил, теперь в коде ничего править не надо.
Код:
[Выделить все]
;|(Kr_LoadSupportPaths)
;(Kr_LoadSupportPaths "D:" "\\Library\\Parameters\\Kr_Paths.txt")
|;
(defun Kr_LoadSupportPaths (disk PathFile / files f subpaths) 
  (vl-load-com)
  (setq files (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
;_________________________
;поддержка supportpath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" subpaths nil key T)
  (while (and key (setq line (read-line f)))
    (if (eq "SupportPath" line)
      (progn
            (while (not (eq "" (setq subpaths (read-line f))))
                (setq paths (strcat paths ";" disk subpaths))
            );while
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths ""))
    (vla-put-supportpath files (strcat (vla-get-supportpath files) paths)))
;_________________________
;стили печати PrinterStyleSheetPath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "PrinterStyleSheetPath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-PrinterStyleSheetPath files paths))
;_________________________
;папка шаблонов TemplateDwgPath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "TemplateDwgPath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-TemplateDwgPath files paths))
;_________________________
;шаблон для новых файлов QNewTemplateFile
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "QNewTemplateFile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-QNewTemplateFile files paths))
;_________________________
;шаблон для новых листов PageSetupOverridesTemplateFile
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "PageSetupOverridesTemplateFile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-PageSetupOverridesTemplateFile files paths))
;_________________________
;папка с палитрами ToolPalettePath
  (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "ToolPalettePath" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
  (if (not (eq paths "")) (vla-put-ToolPalettePath files paths))
;_________________________
;создаем временный профиль
(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) 
;_________________________
;копируем профиль палитры
  ;(vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
  (vl-file-delete
    (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
        "support\\Profiles\\"
      ActiveProfile
        "\\Profile.aws")
    );vl-file-delete

;находим адрес профиля палитры в файле настроек
    (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "ToolPaletteProfile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
;копируем
  (vl-file-copy
    paths
    (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
        "support\\Profiles\\"
      ActiveProfile
        "\\Profile.aws")
    );vl-file-copy
;_________________________
;удаляем временный профиль
      (vla-put-ActiveProfile obj ActiveProfile)
      (vla-DeleteProfile obj temp_profile)
;_________________________
; загружаем меню
  
  ;находим адрес меню в файле настроек
    (setq
    f (open (strcat disk PathFile) "r")
    paths "" key T)
  (while (and key (setq line (read-line f)))
    (if (eq "MenuFile" line)
      (progn
            (setq paths (strcat disk (read-line f)))
               (setq key nil)
        );progn
      );if
    );while
  (close f)
    ;загружаем меню
  (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)
);defun
Вызов:
Код:
[Выделить все]
(Kr_LoadSupportPaths "D:" "\\Library\\Parameters\\Kr_Paths.txt")
Пример файла настроек:
Код:
[Выделить все]
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

PrinterStyleSheetPath
\Library\Parameters\PlotStyles

TemplateDwgPath
\Library\Parameters\Template\

QNewTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

PageSetupOverridesTemplateFile
\Library\Parameters\Template\AutoCAD_Beginning_Black.dwt

ToolPalettePath
\Library\Parameters\Palette\

ToolPaletteProfile
\Library\Parameters\Menu\Profile.aws

MenuFile
\Library\Parameters\Menu\Krieger.cui
__________________
Делай хорошо, плохо само получится.

Последний раз редактировалось Krieger, 18.09.2009 в 07:30.
Krieger вне форума  
 
Непрочитано 18.09.2009, 07:35
#68
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Код:
[Выделить все]
;поддержка supportpath
  (setq
    f (wxXy (strcat disk PathFile) "r")
Цитата:
Сообщение от Krieger Посмотреть сообщение
забыл пример Kr_Paths.txt дать
а я с первого поста брал. Щас поменяю.

Цитата:
Добавил, теперь в коде ничего править не надо
Да, так получше будет. Защита от кривых рук, так сказать.
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 18.09.2009, 07:39
#69
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Цитата:
Сообщение от wetr Посмотреть сообщение
Код:
[Выделить все]
;поддержка supportpath
  (setq
    f (wxXy (strcat disk PathFile) "r")
Посмотри внимательно. Нету такого. Должно быть "open"
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 18.09.2009, 09:07
#70
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от Krieger Посмотреть сообщение
Посмотри внимательно. Нету такого. Должно быть "open"
Или я дурак или лыжи не едут
У тебя в коде из поста 65 и 67 фигурирует такая строка
Код:
[Выделить все]
;папка шаблонов TemplateDwgPath
  (setq
    f (wxXy (strcat disk PathFile) "r"
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 18.09.2009, 09:16
#71
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Че за байда, хорош прикалываться, вот скрин.
Попробуй с другого браузера. Если там будет также, то это шизофрения...
Миниатюры
Нажмите на изображение для увеличения
Название: скрин.jpg
Просмотров: 209
Размер:	39.8 Кб
ID:	26093  
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 18.09.2009, 09:22
#72
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Opera 9.62 IE7
показывают одинаково
какой то баг. Не понятно с чьей стороны.
ЛЮДИ! А как вам видно?
Миниатюры
Нажмите на изображение для увеличения
Название: 1.jpg
Просмотров: 159
Размер:	45.3 Кб
ID:	26094  
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 18.09.2009, 09:26
#73
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


А в другой теме тебе еще и nonoCADы мерещатся...
Давай так попробуем:
Вложения
Тип файла: rar Kr_LoadSupportPaths.rar (1.4 Кб, 139 просмотров)
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 18.09.2009, 09:30
#74
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от Krieger Посмотреть сообщение
А в другой теме тебе еще и nonoCADы мерещатся...
Offtop: Скрин приложить? ааа. Исправил уже

Цитата:
Давай так попробуем
Так нормально!

Добавлено.

Дома отображается так
Цитата:
(setq
f (XWYy (strcat disk PathFile) "r")
Windows Vista, Opera 10, IE7
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)

Последний раз редактировалось wetr, 18.09.2009 в 14:36.
wetr вне форума  
 
Автор темы   Непрочитано 18.09.2009, 15:02
#75
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Код то работает?
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 18.09.2009, 15:07
#76
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,327


проверка
Код:
[Выделить все]
;поддержка supportpath
  (setq
    f (open (strcat disk PathFile) "r")
Opera 10.0
Хмурый вне форума  
 
Непрочитано 18.09.2009, 15:08
#77
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


у меня везде open написано
кстати по теме Krieger - у респект у него все посерьезному сделано, мене на такое не хватило, у меня попроще вот так вота:

Код:
[Выделить все]
(if (and (dos_getini "SHX Map" "mipgost.shx" "c:\\Program Files\\AutoCAD 2008\\Support\\Mtextmap.ini")
	     (dos_getini "SHX Map" "Arial.shx" "c:\\Program Files\\AutoCAD 2008\\Support\\Mtextmap.ini")
	     )
      (princ)
      (progn
    (dos_setini "SHX Map" "mipgost.shx" "MipGost,0,0,0,2,204,238,1" "c:\\Program Files\\AutoCAD 2008\\Support\\Mtextmap.ini")
    (dos_setini "SHX Map" "Arial.shx" "Arial,0,0,0,2,204,238,1" "c:\\Program Files\\AutoCAD 2008\\Support\\Mtextmap.ini")
    )
      )

  (setq sl_tmp_str_ (strcat (vl-string-subst "" "\\Local Settings" (strcat (getvar "LOCALROOTPREFIX") "support")) ";C:\\Program Files\\AutoCAD 2008\\support;C:\\ingilcad\\fonts;C:\\Program Files\\AutoCAD 2008\\help;C:\\Program Files\\AutoCAD 2008\\Express;C:\\Program Files\\AutoCAD 2008\\support\\color;C:\\ingilcad;C:\\ingilcad\\bmp;C:\\ingilcad\\VetCAD++;C:\\ingilcad\\dwg;C:\\ingilcad\\shtrihovki"))
(vla-put-SupportPath (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) sl_tmp_str_)

  (vla-put-AutoSavePath  (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "c:\\ingilcad\\Autosave")
 (vla-put-PrinterConfigPath  (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "c:\\ingilcad\\Plotters")
(vla-put-PrinterStyleSheetPath  (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "c:\\ingilcad\\Plot styles")
(vla-put-PrinterDescPath  (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "c:\\ingilcad\\Plotters\\PMP Files")
Sleekka вне форума  
 
Непрочитано 18.09.2009, 16:44
#78
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,535
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от Krieger Посмотреть сообщение
Код то работает?
Пока не могу проверить. Скорей всего только в понедельник получится
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 23.09.2009, 09:04
#79
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Цитата:
Сообщение от Sleekka Посмотреть сообщение
у меня везде open написано
кстати по теме Krieger - у респект у него все посерьезному сделано, мене на такое не хватило, у меня попроще вот так вота:
Спасибо. Посмотрим что интересного у тебя можно вытащить.
Ну Mtextmap.ini я уже давно не трогаю, вроде бы проблем после эдак AutoCAD2005 или 2006 не было. Видать глюк с подстановкой шрифтов для кадовского редактора текста исправлен...
AutoSavePath - собственно, наверное можно добавить...
PrinterConfigPath - добавлю
PrinterDescPath - PMP ведь прописан в pc3 файле, нафиг ему адрес в настройках?

Кто подскажет. Я не нашел где задать папку для шаблонов подшивки (Sheet Set Template File Location), в AcadPreferences нету такого.
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 23.09.2009, 09:14
#80
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Код:
[Выделить все]
(vl-registry-read (strcat "HKEY_CURRENT_USER\\"
                          (vlax-product-key)
                          "\\Profiles\\"
                          (vla-get-activeprofile (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))))
                          "\\General"
                          ) ;_ end of strcat
                  "SheetSetTemplatePath"
                  )
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Программная настройка AutoCAD, как это делается?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рифмоплетство. Kryaker Разное 554 14.11.2023 11:59
запуск программы из AutoCADа kminas Программирование 19 15.06.2012 13:42
Предложение: Готовые функции Apelsinov Библиотека функций 170 27.06.2010 23:51
Новый драйвер для Phantom AutoCAD OLE/ADI Printer. Как? CyberMan AutoCAD 4 26.04.2009 10:19
Электромагнитная пушка T-Yoke Машиностроение 112 06.08.2008 18:48