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

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

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

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

Программная настройка 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. Причина: Что в итоге получилось
Просмотров: 62149
 
Непрочитано 26.01.2009, 19:00
#21
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 26.01.2009, 19:20
#22
Krieger

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


Цитата:
Сообщение от acyxou Посмотреть сообщение
Krieger, чет не работает.....
А чего говорит?

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

Цитата:
В частности, настройки табличных стилей, описания объектов и свойств, вносимых в спецификации, настройки слоев (для варианта "по умолчанию", без использования механизма ADT
А через объектную модель никак?
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 26.01.2009, 20:26
#23
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.01.2009, 08:38
#24
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,251


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Гарантированно работает под AutoCAD 2008 (то есть требует .NET 2.0). Корректно обрабатывает только XML-файлы в кодировке UTF-8.
Создано немного криво, но пока работает...
P.S. Жду разгромной критики
Спасибо, возьму этот пример за отправную точку. Может не в тему вопрос, и вообще не для этой ветки, но тем не менее, я вижу в парсере работа идёт с COM-сервером "MSXML2.DOMDocument.3.0". Так вот, не знаешь, где можно посмотреть документацию по объектной модели этого COM-сервера?
Makswell вне форума  
 
Непрочитано 27.01.2009, 09:55
#25
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Makswell, Про XML еще здесь есть (требуестя регистрация)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.01.2009, 12:24
#26
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.01.2009, 12:52
#27
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 11,105


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

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

На LISP самому парсер не стоит писать - там тьма важных деталей. Где-то был у меня такой, на Common LISP - замучишься сам делать. Или уж MSXML использовать, или из готового постороннего COM-dll сделать.
ShaggyDoc вне форума  
 
Непрочитано 27.01.2009, 13:01
#28
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.01.2009, 16:32
#29
acyxou


 
Регистрация: 12.07.2008
Сообщений: 211


Krieger, наконец-то разобрался с этими долбанными ToolPalettes!!!!
А за код отдельное спасибо!
acyxou вне форума  
 
Непрочитано 05.02.2009, 19:57
#30
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Функция (_kpblc-lisp-appload-autostart-save "Demo.lsp") возвращает
вот такое значение:
Код:
[Выделить все]
_$  (_kpblc-lisp-appload-autostart-save "Demo.lsp")
"6"
_$
и в добавок эту "6" - добавляет в "startup" под "NumStartup"
я это проверил через "regedit", а в Автозагрузку "АР" в чемодан
ничего не прописала, это только у меня эта функция так работает?
Holon вне форума  
 
Непрочитано 06.02.2009, 01:53
#31
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.02.2009, 08:53
#32
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Код:
[Выделить все]
(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
Holon вне форума  
 
Непрочитано 06.02.2009, 09:27
#33
Кулик Алексей aka kpblc
Moderator

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


Попробуй это:
Код:
[Выделить все]
(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. Странноватый немного код ты показал... похоже на переделку.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.02.2009, 11:56
#34
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Сейчас протестировал твой код на двух 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 не подгружена!
Holon вне форума  
 
Непрочитано 06.02.2009, 12:11
#35
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,800
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Holon, Holon, Может проще в acad.mnl дописать строчку
(load "demo.lsp") ?
PS Про запись в автозагрузку есть еще здесь. Автор тот же
Приведу цитату Алексея из этой ветки
Цитата:
Если честно, я плюнул разбираться с реестром. Намного проще использовать mnl-файл либо acaddoc.lsp.
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 06.02.2009 в 15:55. Причина: Орфография
VVA вне форума  
 
Непрочитано 06.02.2009, 12:19
#36
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Да нет проблем, только зачем ее всё время подгружать, можно как-то так сделать
Код:
[Выделить все]
"[Menu1]^C^C^P(if (not (C:at)) (load \"demo.lsp\"))at"
просто у Алексея функция красивая, да в добавок если я mnl файл пользовать небуду?
Holon вне форума  
 
Непрочитано 08.09.2009, 07:56
#37
wetr

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


Что-то тема канула в лету, а что сейчас происходит с программной настройкой Автокада?
Krieger, можешь показать, как ты сейчас это делаешь?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 08.09.2009, 19:47
#38
Krieger

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


Сейчас? Ваще лафа. Процесс настройки выглядит таким образом: копирую всю свою библиотеку со всеми примочками на винчестер. Захожу в эту папку, запускаю 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")
              ))
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 09.09.2009, 02:27
#39
wetr

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


Цитата:
...копирую всю свою библиотеку со всеми примочками на винчестер.
У меня предполагается программная настройка нескольких компов в сети. Библиотеку я должен скопировать на сервак? На всех компах подключен сетевой диск. Называется одинаково, типа:
Код:
[Выделить все]
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?
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Автор темы   Непрочитано 09.09.2009, 09:11
#40
Krieger

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


Цитата:
Сообщение от 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))
Остальные лиспы загружаются по мере надобности, в процессе работы. Благо адреса уже прописаны.
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Программная настройка AutoCAD, как это делается?

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рифмоплетство. Kryaker Разное 519 18.09.2019 18:52
запуск программы из 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