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

Krieger · 23.01.2009, 16:34

Программная настройка 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

Supermax · 24.01.2009, 13:20

Очень полезная работа. Продолжай. Это первый шаг для создания программного способа перестройки панелей инструментов.

Кулик Алексей aka kpblc · 24.01.2009, 13:31

с группировкой палитр я тоже долго воевал, но так и не понял, где оно хранится

Krieger · 24.01.2009, 17:29

Ба-а-а-лиииин....
Идиотскую ошибочку сделал в коде, поэтому и вылетали gui и pgp.
Так, теперь у меня устанавливаются пути поддержки. А multiload.lsp добавляется в автозагрузку. Только чтобы он добавился в атозагрузку надо сначала выполнить код, потом сразу же перезагрузить кад и выполнить команду appload и снова перезагрузить кад, тогда сработает автозагрузка. Проще вручную добавить...
Насчет настройки интерфейса. Поскольку профиль загрузить не получается (хотя zouss намекал что можно как-то через VBA загрузку сделать, но там я полный нуль), можно попытать рабочие пространства (workspaces), которые цепляются к cui, ну а cui можно грузить через cuiload с filedia = 0. (command "_.cuiload" "d:mycui")

ps Надо было в названии топика использовать слово "Кризис"...

Огурец · 24.01.2009, 17:39

Дорогие коллеги!

Тема наиважнейшая. Я на неё подписываюсь и буду задавать вопросы "от чайника".

Переход на Windows-7 неизбежен, причём единовременно, причем сразу и у многих. Если удастся преносить профиль работы программными средствами, будет намного легче.

Supermax · 24.01.2009, 18:44

Цитата:

...Так, теперь у меня устанавливаются пути поддержки. А multiload.lsp добавляется в автозагрузку. Только чтобы он добавился в атозагрузку надо сначала выполнить код, потом сразу же перезагрузить кад и выполнить команду appload и снова перезагрузить кад, тогда сработает автозагрузка. ...

Не катит!
Никаких перезагрузок када!
Надо в автозагрузку что-то хитрое вставить, чтобы не меняя ее иметь возможность добавлять к аппендиксу автозагрузки дополнительные лиспы.
Типа как я тут с Kpblc-ом химичил. http://forum.dwg.ru/showthread.php?t=27840
Просто надо добавить процедуру загрузки (выполнения) твоего файла multiload.lsp.

Krieger · 24.01.2009, 19:40

В общем с рабочими пространсвами не получается. Так как после загрузки cui нужно вручную перетаскивать раб. простр. из своего cui в основоной. Иначе оно не появляется в списке раб.простр., и такое не прокатит:

Код:

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

(command "_cuiload" "Krieger.cui")
(command "_workspace" "setCurrent" "Krieger_workspace")

Ладно, похоже все равно прийдется cui грузить, во всяком случае пригодится, например для настройки дублклика. Тогда сделаем одноименный mnl файл и кинем его вместе с файлом адаптации. В этом файле пропишем загрузку мультизагрузчика (load "multiload.lsp"). После загрузки нашего cui будет выполнятся и одноименный mnl с каждым открываемым файлом.

А вот с настройкой интерфеса пока не занаю чего делать. Для палитр можно тупо aws файлы копировать...

wetr · 26.01.2009, 13:14

Krieger, отличная идея. Было бы не плохо получить универсальную оболочку в которую можно вписать свои настройки (а таких немало). Готов поучаствовать, но толку с меня...Но моральная поддержка гарантируется

Makswell · 26.01.2009, 14:01

Krieger, всё таки, а чем экспорт/импорт профиля не устаривает? Это тоже можно сделать программно. Тоже в итоге всё может свестись к: "копированию (можно ручному) файлов на комп пользователя, запуск када, перетаскиванию в него lsp файлика, перезагрузка када."... можно даже без перезагрузки обойтись.

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

С вариантом экспорта/импорта профиля лисп файл может выглядеть так:

Код:

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

(load "d:\\path\\profile_import.LSP");загрузка функции импорта профиля
(profile_import "Your_Profile" "D:\\path\\Your_Profile.arg" :vlax-true);импорт профиля с установкой его текущим.

Krieger · 26.01.2009, 14:19

Цитата:

Сообщение от Makswell

Krieger, всё таки, а чем экспорт/импорт профиля не устаривает? Это тоже можно сделать программно.

Да я обеими руками за, ты скажи как??? Выложи этот "profile_import.LSP". Я не знаю, поэтому и создал эту тему.
Яж с этого и начал:

Цитата:

Сообщение от Krieger

Но вот палитры добавил, а как их настроить? Т.е. палеток-то там много, нужно создать группу и запихать туда только некоторые. При ручной загрузке профиля все красиво получается и пути устанавливаюся и кнопки на нужном месте. Может как-то можно программно загрузить профиль?

Makswell · 26.01.2009, 14:31

Вот функция импорта профиля. Как она сделана у меня.

Код:

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

;;; ************************************************************************
;;; <<<ОПИСАНИЕ>>>
;;; импорт профиля из arg-файл
;;;
;;; ************************************************************************
;;; <<<ВОЗВРАЩАЕМОЕ ЗНАЧЕНИЕ>>>
;;; нет
;;;
;;; ************************************************************************
;;; <<<АРГУМЕНТЫ>>>
;;; Profile - новое имя профиля (строка)
;;; RegFile - имя файла с расширением arg
;;; key - включение путей
;;;       :vlax-true - включает в профиль пути поддержки,
;;;       определённые в arg-файле
;;;       :vlax-false - Не включает в профиль пути поддержки,
;;;       определённые в arg-файле
;;;
;;; ************************************************************************
;;; <<<ПРИМЕРЫ>>>
;;; (profile_import "Your_Profile" "D:\\path\\Your_Profile.arg"
;;; :vlax-true)
;;;
;;; ************************************************************************
(defun profile_import
			(Profile_Name	     RegFile
			 key		     /
			 M-vla_PreferencesProfiles
			 ActiveProfile	     temp_profile
			)
  (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)
      (vla-put-ActiveProfile M-vla_PreferencesProfiles Profile_Name)
      (vla-DeleteProfile M-vla_PreferencesProfiles temp_profile)
    )
    (alert (strcat "Файл: " RegFile "\nне найден!"))
  )
  (princ)
)

Makswell · 26.01.2009, 15:01

Цитата:

Сообщение от Krieger

Но вот палитры добавил, а как их настроить? Т.е. палеток-то там много, нужно создать группу и запихать туда только некоторые. При ручной загрузке профиля все красиво получается и пути устанавливаюся и кнопки на нужном месте. Может как-то можно программно загрузить профиль?

Про палитры я когда-то писал вот здесь. . Может это что-нибудь прояснит?

acyxou · 26.01.2009, 15:10

Krieger, а можно специально для меня выдернуть код для прописывания ToolPalettes Paths?...a то я с Lispom не дружу пока

Только без внешнего тесткового файла.... проcто чтоб код менял ToolPalettesPath на, например, этот: "\\Server\CAD\Tolpalettes".
Заранее спасибо!

Кулик Алексей aka kpblc · 26.01.2009, 15:14

В общем, я так понимаю, что надо уже постепенно созревать на публикацию лиспового XML-парсера

Правда, он не безгрешен...

Makswell · 26.01.2009, 15:26

Кулик Алексей aka kpblc, было бы небезынтересно посмотреть...

Кулик Алексей aka kpblc · 26.01.2009, 16:19

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

Krieger · 26.01.2009, 17:07

Цитата:

Сообщение от Makswell

Вот функция импорта профиля. Как она сделана у меня.

Спасибо. Работает.

И как я не нашел этот метод ImportProfile... Искал ведь.
Ну вот не поверю, что окромя Makswell никто не знал как профиль импортировать. Теперь все вроде решаемо. И с палитрами тоже, так как их настройки тоже сохраняются в профиле. (Добавлено: не, нифига, не сохраняются)

acyxou,

Код:

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

; (Kr_LoadToolPalettePath "E:\\Library\\Parameters\\Palette\\")
(defun Kr_LoadToolPalettePath (path)
(vla-put-ToolPalettePath (vla-get-files (vla-get-preferences (vlax-get-acad-object))) path)
  )

Krieger · 26.01.2009, 17:11

Цитата:

Сообщение от Кулик Алексей aka kpblc

В общем, я так понимаю, что надо уже постепенно созревать на публикацию лиспового XML-парсера

Правда, он не безгрешен...

А что ты в xml правишь? Т.е. можно подредатировать aws.

Кулик Алексей aka kpblc · 26.01.2009, 18:31

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

acyxou · 26.01.2009, 18:35

Krieger, чет не работает.....

Кулик Алексей aka kpblc · 26.01.2009, 19:00

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

Krieger · 26.01.2009, 19:20

Цитата:

Сообщение от acyxou

Krieger, чет не работает.....

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

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

Цитата:

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

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

Кулик Алексей aka kpblc · 26.01.2009, 20:26

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

Makswell · 27.01.2009, 08:38

Цитата:

Сообщение от Кулик Алексей aka kpblc

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

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

VVA · 27.01.2009, 09:55

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

Кулик Алексей aka kpblc · 27.01.2009, 12:24

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

ShaggyDoc · 27.01.2009, 12:52

Алексей, а

Цитата:

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

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

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

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

Кулик Алексей aka kpblc · 27.01.2009, 13:01

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

acyxou · 27.01.2009, 16:32

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

Holon · 05.02.2009, 19:57

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

Код:

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

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

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

Кулик Алексей aka kpblc · 06.02.2009, 01:53

Holon, этой функции сто лет в обед уже

Код приведи (там могли быть ошибки).

Holon · 06.02.2009, 08:53

Код:

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

(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 · 06.02.2009, 09:27

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

Код:

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

(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 · 06.02.2009, 11:56

Сейчас протестировал твой код на двух 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 · 06.02.2009, 12:11

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

Приведу цитату Алексея из этой ветки

Цитата:

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

Holon · 06.02.2009, 12:19

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

Код:

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

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

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

wetr · 08.09.2009, 07:56

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

Krieger · 08.09.2009, 19:47

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

Цитата:

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

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

Код:

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

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 · 09.09.2009, 09:11

Цитата:

Сообщение от 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))

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

wetr · 09.09.2009, 10:14

Цитата:

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

kr_Load - это мультизагрузчик лисп-файлов?
Блин, где взять .aws?
После чтения справки, нашел только в архиве, после экспорта настроек автокада (Migrate Custom Settings).
Про палитры - самое главное. У меня там почти все сидит.

Как я понял порядок действий:
1. Копируем все *.lsp файлы, картинки кнопок в сетевую папку (допустим \\server\cad\profile)
2. Сохраняем *.arg файл профиля туда же
3. Сохраняем *.cui файл туда же (кстати, где взять чистый cui)
4. Сохраняем *.xtp файлы экспорта палитр и *.xpg файлы экспорта групп (?)
5. Сохраняем *.aws с настройками палитр туда же (кстати, в справке сказано, что он подойдет только для экспорта на комп с аналогичным автокадом - предварительно нужно всем одинаковый кад ставить)
6. Закидываем в кад kr_Load.lsp
7. Перегружаем кад.
8. Идем за ящиком пива для Krieger

Makswell · 09.09.2009, 10:24

Цитата:

Сообщение от Krieger

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

Здесь присутствует небольшой косяк. Если переносишь свои настройки с русского на английский Автокад или наоборот, то в профиле-то остаётся название редактора на чуждом языке. И как следствие этот редактор не запускается.

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

Код:

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

;;;текствый редактор - встроенный. Специально для локализованного Автокада
(setvar "MTEXTED" ".")

Так срабатывает для любого Автокада

Krieger · 09.09.2009, 10:42

Цитата:

Сообщение от wetr

kr_Load - это мультизагрузчик лисп-файлов?

Ну мульти не мульти, просто аналог функции load, можно и без неё обойтись.

Код:

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

(defun kr_Load (lsp)
(if (setq full_name_lsp (findfile lsp)) 
      (if 
        (equal (load full_name_lsp "Failed") "Failed") 
         (princ 
           (strcat 
             "\nПрограмма \n" 
             full_name_lsp 
             "\nне может быть загружена! Возможно она испорчена!" 
           ) ;_ end of strcat 
         ) ;_ end of princ 
        ;;Это сообщение для отладки. Можно закомментировать 
         (princ 
           (strcat 
             "\nПрограмма \n" 
             full_name_lsp 
             "\nзагружена" 
           ) ;_ end of strcat 
         ) 
      ) ;_ end of IF 
              (princ 
           (strcat 
             "\nПрограмма \n" 
             lsp 
             "\nне найдена!" 
           ) ;_ end of strcat 
         ) ;_ end of princ 

    ) ;_ end of if
  )

Цитата:

Блин, где взять .aws?

Вот тут он сидит:
C:\Documents and Settings\<имя юзера>\Application Data\Autodesk\AutoCAD 2008\R17.1\enu\Support\Profiles\<название профиля в каде>\Profile.aws
Т.е. настраиваем кад как надо, потом его от туда и возьмешь уже готовенький. Потом остается только на остальных компах его туда подкидывать.

Цитата:

1. Копируем все *.lsp файлы, картинки кнопок в сетевую папку (допустим \\server\cad\profile)

Ну не знаю, стоит ли все в кучу валить, у меня все по папочкам раскидано

Цитата:

2. Сохраняем *.arg файл профиля туда же
3. Сохраняем *.cui файл туда же (кстати, где взять чистый cui)

Эти у меня тоже в отдельной папке menu.

Цитата:

4. Сохраняем *.xtp файлы экспорта палитр и *.xpg файлы экспорта групп (?)

Нафиг не надо. Я их ни куда не импортирую. Просто копирую в сотаве моей библиотеки папку с палитрами, эта папка прописывается в настройках када и он напрямую с ней работает.

Цитата:

5. Сохраняем *.aws с настройками палитр туда же (кстати, в справке сказано, что он подойдет только для экспорта на комп с аналогичным автокадом - предварительно нужно всем одинаковый кад ставить)

Ну да. Этот файл я взял с 2008-го, ставился он благополучно и на 2009, на 2010-м не пробовал. Ну не встанет поменяешь на новый.

Цитата:

6. Закидываем в кад kr_Load.lsp

Нафига?

Цитата:

7. Перегружаем кад.

Тоже нафига?

Цитата:

8. Идем за ящиком пива для Krieger

А это всегда пожалуйста.

Цитата:

Сообщение от Makswell

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

Спасибо, попробую.

Makswell · 09.09.2009, 11:13

К №42. Забыл добавить.
Это прописано естественно после действий по импорту профиля. Иначе при импорте эта настройка опять перепишется.

acyxou · 09.09.2009, 11:38

В Inno Setup компилим инсталяху, юзер ее запускает сам, она производит кастом акада (-ов) в зависимости от установленной версии. Почти весь кастом, кроме библиотеки блоков и стилей для АСА, а также *.pc3 файлов хранится на компе пользователя. Обновления происходят политикой домена при очередном включении компутера юзера... Идет проверка версий файлов на компах юзеров и на моем компе, ну и обновляется то что устарело

Krieger · 09.09.2009, 12:09

И как в Inno Setup импортировать профиль в кад?

acyxou · 09.09.2009, 13:01

Никак

При установке, прога удаляет все автокадовские ярлыки с рабочего стола пользователя, а вместо них помещает точно такие же, но свои, в которых прописано "C:\Program Files\AutoCAD 2009\acad.exe" /p "C:\AmcCAD\AutoCAD2009\Standards\AmcCAD2009.arg"

wetr · 10.09.2009, 02:34

Цитата:

Просто копирую в сотаве моей библиотеки папку с палитрами, эта папка прописывается в настройках када и он напрямую с ней работает

А что такое папка с палитрами? Картинки кнопок, которые появляются после экспорта? Или что то другое?

Цитата:

6. Закидываем в кад kr_Load.lsp

Нафига?

Тьфу ты! Уже запутался. Нужно Kr_AutoSetup забрасывать?
А потом перезагружать...?

Кулик Алексей aka kpblc · 10.09.2009, 02:40

Подозреваю, что "нафига" относилось к перезагрузке AutoCAD'a...

wetr · 10.09.2009, 07:37

Цитата:

Сообщение от acyxou

В Inno Setup компилим инсталяху, юзер ее запускает сам, она производит кастом акада (-ов) в зависимости от установленной версии. Почти весь кастом, кроме библиотеки блоков и стилей для АСА, а также *.pc3 файлов хранится на компе пользователя. Обновления происходят политикой домена при очередном включении компутера юзера... Идет проверка версий файлов на компах юзеров и на моем компе, ну и обновляется то что устарело

Это совет, или так делается у вас в конторе?

Krieger · 10.09.2009, 09:33

Цитата:

Сообщение от wetr

А что такое папка с палитрами? Картинки кнопок, которые появляются после экспорта? Или что то другое?

Я имею ввиду папку прописанную в настройках када в строке Tool Palettes File Locations (см. картинку). Чтобы сделать такую же свою и не разбираться чего выдрать из старой папки, сделай все таки один раз экспорт своих палеток; назначь в настройках свою папку, хоть и пока пустую; все палетки исчезнут с палитры; сделай импорт своих, они пропишутся во вновь указанной тобой папке. В дальнейшем именно эту папку и будешь таскать с собой, в ней есть все что необходимо для функционирования палитры, без всяких экспортов/импортов.

Цитата:

Сообщение от wetr

Тьфу ты! Уже запутался. Нужно Kr_AutoSetup забрасывать? А потом перезагружать...?

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

acyxou · 10.09.2009, 14:03

Цитата:

Сообщение от wetr

Это совет, или так делается у вас в конторе?

Так я делаю у нас в конторе...

Sleekka · 15.09.2009, 17:40

Цитата:

Так я делаю у нас в конторе...

У тебе домены есть - счастливый!

acyxou · 15.09.2009, 18:44

Sleekka
Если знаком с vbscript, то можно обновлять файлы на пользовательских компах посредством него

Кулик Алексей aka kpblc · 15.09.2009, 18:48

acyxou, хорош томить, покажи пример

wetr · 16.09.2009, 07:24

Krieger, до меня наконец дошло - вариант с импортом профиля подходит только, если настраиваешь компьютер для себя и твой профиль тебя устраивает. Если я настраиваю автокад другим людям, менять профиль не желательно. Т.е. такой вариант не совсем подходит. Тут нужно менять именно пути поддержки на сетевые, где лежат все настройки. Подгружать необходимые лиспы и делать активной нужную палетку.

Krieger · 16.09.2009, 07:43

Ну, у меня всего 2 профиля которые всех устраивают на 90%. В одном профиле цветовая схема с белым экраном в другом с черным. При импорте кнопок все панели инструментов исчезают за ненадобностью, т.к. все они продублированы на палитре инструментов. Единственное что люди иногда подстраивают под себя это настройки правой кнопки мыши, что не долго сделать. Потом я ставлю обычно при первой же настройке када, после его установки.
Импорт профиля - самое простое что можно придумать, причем это самое простое учитывает любые мелочи. Можешь попробовать совместно с профилем поиграться с рабочим пространством.

acyxou · 16.09.2009, 11:08

Кулик Алексей aka kpblc, я просто знаю что так делают и что его админы используют очень широко, сам же я vbscript'ом не владею, но как понимаю должно быть что-то вроде этого:

Код:

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

Dim objFSO, WSHNetwork
Const OverWriteExisting = True
Set objFSO = Createobject("Scripting.FileSystemObject")
Set WSHNetwork = Createobject("Wscript.Network")
strComputer = WSHNetwork.Computername
wsLocation = "\\"& strComputer & "\c$\Temp\"
objFSO.CopyFile "\\server\share\file.txt", wsLocation, OverWriteExisting

Krieger, а как же третий профиль для серого цвета фона

)))
Глянь лучше это
Я тоже столкнулся с проблемой подстройки профиля под нужды юзера. Вот что они себе меняют:

Цвет фона
Настройки правой кнопки миши
Некоторые хотят чтоб в заголовке окна выводилось полное имя файла включая путь
Размеры перекрестия (некоторые любят чтоб крестик был на весь экран)
Некоторые настраивают перекрестие так чтоб он не менял свой вид во время активирования какой-либо команды

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

Krieger · 16.09.2009, 12:22

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

, только потому что я на черном работаю, а остальным до лампочки. Так что потихоньку переходим на единый стиль

acyxou · 16.09.2009, 15:26

Offtop: Krieger, а вообще надо уважать пользователей!
Представь если тебя кто-то завтра жестко заставит чертить на белом фоне... естественно от тебя пойдет негатив в ответ

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

Krieger · 16.09.2009, 15:36

Я уважаю. Я же говорю что перешли те, кому "до лампочки". Кто не захотел переходить, тот так и продолжает работать.

wetr · 17.09.2009, 01:31

Цитата:

Сообщение от acyxou

но сейчас всегда стараюсь учитывать их интересы и желания

И это правильно!

Цитата:

Сообщение от acyxou

Я тоже столкнулся с проблемой подстройки профиля под нужды юзера. Вот что они себе меняют:Цвет фона
Настройки правой кнопки миши
Некоторые хотят чтоб в заголовке окна выводилось полное имя файла включая путь
Размеры перекрестия (некоторые любят чтоб крестик был на весь экран)
Некоторые настраивают перекрестие так чтоб он не менял свой вид во время активирования какой-либо команды

Но это опять же частный случай. Настроек может быть очень много

Krieger · 17.09.2009, 09:41

Тогда надо соединить первый код в первом постинге, копирование палитры и загрузку 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. Загрузить своё меню.

Что еще?

wetr · 17.09.2009, 09:58

7. Установить необходимые палитры текущими?
8. Еще лиспы загрузить и добавить в автозагрузку.
Стили будут храниться в шаблоне.
Слои тоже можно самые основные. Остальные слои создавать программно.

Krieger · 17.09.2009, 10:24

Цитата:

Сообщение от 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

wetr · 18.09.2009, 02:46

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

Подскажи пример вызова плиз.
Пытаюсь:

Код:

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

(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")

закомментированы?

Krieger · 18.09.2009, 06:17

Так, извиняюсь, забыл пример 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

wetr · 18.09.2009, 07:35

Код:

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

;поддержка supportpath
  (setq
    f (wxXy (strcat disk PathFile) "r")

Цитата:

Сообщение от Krieger

забыл пример Kr_Paths.txt дать

а я с первого поста брал. Щас поменяю.

Цитата:

Добавил, теперь в коде ничего править не надо

Да, так получше будет. Защита от кривых рук, так сказать.

Krieger · 18.09.2009, 07:39

Цитата:

Сообщение от wetr

Код:

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

;поддержка supportpath
  (setq
    f (wxXy (strcat disk PathFile) "r")

Посмотри внимательно. Нету такого. Должно быть "open"

wetr · 18.09.2009, 09:07

Цитата:

Сообщение от Krieger

Посмотри внимательно. Нету такого. Должно быть "open"

Или я дурак или лыжи не едут

У тебя в коде из поста 65 и 67 фигурирует такая строка

Код:

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

;папка шаблонов TemplateDwgPath
  (setq
    f (wxXy (strcat disk PathFile) "r"

Krieger · 18.09.2009, 09:16

Че за байда, хорош прикалываться, вот скрин.
Попробуй с другого браузера. Если там будет также, то это шизофрения...

wetr · 18.09.2009, 09:22

Opera 9.62 IE7
показывают одинаково
какой то баг. Не понятно с чьей стороны.
ЛЮДИ! А как вам видно?

Krieger · 18.09.2009, 09:26

А в другой теме тебе еще и nonoCADы мерещатся...
Давай так попробуем:

wetr · 18.09.2009, 09:30

Цитата:

Сообщение от Krieger

А в другой теме тебе еще и nonoCADы мерещатся...

Offtop: Скрин приложить?

ааа. Исправил уже

Цитата:

Давай так попробуем

Так нормально!

Добавлено.

Дома отображается так

Цитата:

(setq
f (XWYy (strcat disk PathFile) "r")

Windows Vista, Opera 10, IE7

Krieger · 18.09.2009, 15:02

Код то работает?

Хмурый · 18.09.2009, 15:07

проверка

Код:

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

;поддержка supportpath
  (setq
    f (open (strcat disk PathFile) "r")

Opera 10.0

Sleekka · 18.09.2009, 15:08

у меня везде 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")

wetr · 18.09.2009, 16:44

Цитата:

Сообщение от Krieger

Код то работает?

Пока не могу проверить. Скорей всего только в понедельник получится

Krieger · 23.09.2009, 09:04

Цитата:

Сообщение от Sleekka

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

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

Кто подскажет. Я не нашел где задать папку для шаблонов подшивки (Sheet Set Template File Location), в AcadPreferences нету такого.

Кулик Алексей aka kpblc · 23.09.2009, 09:14

Код:

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

(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"
                  )

Krieger · 23.09.2009, 09:21

Спасибо. Можно проще - getenv его читает нормально (getenv "SheetSetTemplatePath")

Кулик Алексей aka kpblc · 23.09.2009, 09:24

Лично я с getenv последнее время стараюсь связываться поменьше. Запросто способен вернуть каталог с ~ (т.е. обрезанный по принципу 8.3). Вдобавок регистр читаемого имени имеет значение. А в реестре как-то с этим попроще обычно. Правда, Autodesk и здесь не удержался, свинью ухитрился подложить.

wetr · 23.09.2009, 12:17

Krieger, все работает! Спасибо. только вот все равно приходиться ручками группу в палитрах создавать и перетаскивать туда палетты

Krieger · 23.09.2009, 12:46

Цитата:

Сообщение от wetr

Krieger, все работает! Спасибо. только вот все равно приходиться ручками группу в палитрах создавать и перетаскивать туда палетты

Странно. У меня автоматом применяется. Для начала нужно настроить ручками так как оно должно быть. А именно, назначить свой адрес для палитры инструментов (Tool Palettes File Locations), который и будем копировать для переноса палитры; импортировать все наужные палетки (они пропишутся в этой папке); назначить группы и настроить отображение палитры; перезагрузить AutoCAD (или поменять профиль на другой); после перезагрузки када перепишится файл Profile.aws - вот его и надо себе скопировать в укромное местечко, которое потом указывается в файле настроек с адресами. Если все сделано правильно, то должно работать.
Я, кстати, переделал всю прогу, чуть позже выложу.

_____________
Добавлено:

Вот обновленная версия. Добавил проверок, пунктов настройки, создание папок.

Код:

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

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

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

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

;Kr_FindTextFileNextString - ищет строку по образцу и выдает следующую
(defun Kr_FindTextFileNextString (File String / key line NextString f promt)
  (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 (eq NextString "") (wcmatch NextString "* *")) (setq NextString nil))
  NextString
  );defun


(defun Kr_AutoSetupNoProfile (FirstPath PathFile / files key f subpaths obj ActiveProfile temp_profile)
  (vl-load-com)
  (setq files (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
;поддержка 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 "\naddress SupportPath is not found")
    );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 "\naddress PrinterStyleSheetPath is not found"));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 "\naddress TemplateDwgPath is not found"));if
;шаблон для новых файлов QNewTemplateFile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "QNewTemplateFile")))
    (vla-put-QNewTemplateFile files paths) (princ "\naddress is not found"));if
;шаблон для новых листов PageSetupOverridesTemplateFile
  (if (setq paths (strcat FirstPath (Kr_FindTextFileNextString (strcat FirstPath PathFile) "PageSetupOverridesTemplateFile")))
    (vla-put-PageSetupOverridesTemplateFile files paths) (princ "\naddress PageSetupOverridesTemplateFile is not found"));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 "\naddress ToolPalettePath is not found"));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 "\naddress AutoSavePath is not found"));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 "\naddress PrinterConfigPath is not found"));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 "\naddress PrinterDescPath is not found"));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)
      ;;удаляем старый профиль палитры
      (vl-file-delete
            (strcat (vl-registry-read (strcat "HKEY_CURRENT_USER\\" (vlax-product-key)) "RoamableRootFolder")
            "support\\Profiles\\" 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\\" ActiveProfile "\\Profile.aws")
        );vl-file-copy
      (princ "\nProfile.aws - found")
      (princ "\nProfile.aws - not found")
      )
      ;;папка шаблонов для подшивок 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 "\naddress SheetSetTemplatePath is not found"));;if
      ;;возвращаем активный профиль и удаляем временный
          (vla-put-ActiveProfile obj ActiveProfile)
          (vla-DeleteProfile obj temp_profile)
    );progn
    (princ "\naddress ToolPaletteProfile is not found"));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 " - not found"))
      );
       (princ "\naddress MenuFile is not found"));if
  (princ "\nAdjustment is finishedd")
);defun

Пример PathFile:

Код:

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

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

Специально для wetr в архиве:

Krieger · 01.10.2009, 11:55

Так, еще кое-что дописал, функция теперь более универсальная. Т.е. теперь её можно использовать для настройки как чужого компьютера так и своего. Для чужого компа профиль не импортируется, т.е. все прочие настройки кроме прописки адресов остаются на месте. Для своего компа логично импортировать таки профиль, что бы сохранить любые адаптированные под себя мелочи.
Если в файле настроек 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
\Library\Parameters\Menu\acad.pgp

Sleekka · 01.10.2009, 11:58

Спасибо Krieger. Весьма пользительно.

wetr · 03.02.2010, 05:24

Krieger, у меня последняя версия не работает.
И предпоследняя (та, что из архива) тоже

Код:

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

Command: (load "Kr_AutoSetupNoProfile")(Kr_AutoSetupNoProfile "T:" 
"\\КОП\\ПГС\\ACAD 2009 settings\\Paths.txt")

SupportPath - found
address SupportPath is not found
PrinterStyleSheetPath - found; error: bad argument type: stringp nil

Код:

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

Command: (load "Kr_AutoSetup")(Kr_AutoSetup "T:" "\\КОП\\ПГС\\ACAD 2009 
settings\\Paths.txt")

Profile - not found
SupportPath - found
Адрес SupportPath не найден
PrinterStyleSheetPath - found; error: bad argument type: stringp nil

Код:

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

SupportPath
\КОП\ПГС\ACAD 2009 settings\Files
\КОП\ПГС\ACAD 2009 settings\ARX
\КОП\ПГС\ACAD 2009 settings\LISP\Icons
\КОП\ПГС\ACAD 2009 settings\VetCAD++
\КОП\ПГС\ACAD 2009 settings\Fonts
\КОП\ПГС\ACAD 2009 settings\LISP
\КОП\ПГС\ACAD 2009 settings\PLTools
\КОП\ПГС\ACAD 2009 settings\LIN


PrinterStyleSheetPath
\КОП\ПГС\ACAD 2009 settings\Plot Styles

TemplateDwgPath
\КОП\ПГС\ACAD 2009 settings\Шаблон

SheetSetTemplatePath
\КОП\ПГС\ACAD 2009 settings\SheetSet

QNewTemplateFile
\КОП\ПГС\ACAD 2009 settings\Шаблон\универсальный.dwt

PageSetupOverridesTemplateFile
\КОП\ПГС\ACAD 2009 settings\Шаблон\универсальный.dwt

ToolPalettePath
\КОП\ПГС\ACAD 2009 settings\ToolPalette

ToolPaletteProfile
\КОП\ПГС\ACAD 2009 settings\Profile 2009\Profile.aws

MenuFile
\КОП\ПГС\ACAD 2009 settings\CUI\myCUI.cui

Что бы это могло быть?

Krieger · 18.02.2010, 06:13

> wetr
Корень бед я пока вижу в пробелах. Их нужно убрать. Тут два варианта:
1. В своих адресах у брать пробелы.
2. Или в коде попробовать убрать строчку " (wcmatch NextString "* *") " просто выделить по этим скобкам и удалить.

Использовать последний код.

wetr · 18.02.2010, 08:06

Цитата:

Сообщение от Krieger

> wetr
Корень бед я пока вижу в пробелах. Их нужно убрать. Тут два варианта:
1. В своих адресах у брать пробелы.
2. Или в коде попробовать убрать строчку " (wcmatch NextString "* *") " просто выделить по этим скобкам и удалить.

Использовать последний код.

Спасибо. Попробую.
Думаю лучше 1 вариант, а то потом опять где нибудь вылезет

shartal · 09.04.2010, 18:19

Господа, а как воспользоваться данным файлом. Загрузить как лисп? Отвечает, что ошибка и аргументов мало.

Krieger · 09.04.2010, 18:41

Использовать последний код в посту №85.
Лисп загрузить и выполнить функцию с необходимыми параметрами. Пример запуска есть в коде

Цитата:

(Kr_AutoSetup "D:" "\\Library\\Parameters\\Menu\\Kr_Paths.txt")

http://dwg.ru/pub/9

shartal · 15.04.2010, 16:17

Спасибо, все отлично. Можно ли добавить загрузку корпоративного (enterprise) файла cui?

Krieger · 15.04.2010, 16:22

А что это за gui такое? Просто еще одно меню?

shartal · 15.04.2010, 16:59

Это меню добавляемое к основному. Основное меню неизменно. Корпоративное может программно изменяться.

Krieger · 15.04.2010, 17:10

Ну есть же пункт в файле настроек:

Код:

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

MenuFile
\Library\Parameters\Menu\Krieger.cui

Позже добавлю возможность добавления нескольких cui.
Или я дурак, или лыжи не едут...

shartal · 15.04.2010, 17:37

Он заменит основной файл. А надо чтобы его оставит и заменил корпоративный.

Krieger · 15.04.2010, 17:42

Меню не заменяются, а добавляются. Набери в комстроке "menuload" и увидишь что их несколько.

shartal · 15.04.2010, 17:56

Тогда это получаются частичные файлы cui, которые добавляются в основной. В разделе Настройки есть спец. место для корпоративного cui предприятия.

Krieger · 15.04.2010, 18:38

Корпоративное меню к какому меню цепляться должно?

shartal · 16.04.2010, 10:23

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

acyxou · 16.04.2010, 10:25

Ребята, а вы пробовали открыть экспортированный профиль автокада в блокноте?

Krieger · 16.04.2010, 10:29

shartal
Вроде дошло, посмотрю что можно сделать.

acyxou
Пробовал. А что?

Кулик Алексей aka kpblc · 16.04.2010, 10:33

Обычный reg-файл. Другой вопрос, что там могут быть не всегда очевидные моменты

wetr · 11.11.2010, 06:40

Krieger, последний вариант лиспа у меня выдает ошибку где-то среди

Код:

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

;папка для файлов автосохранения 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

Код:

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

Command: _appload START.lsp successfully loaded.


Command:
Profile - not found
SupportPath - found
PrinterStyleSheetPath - found
TemplateDwgPath - found
QNewTemplateFile - found
PageSetupOverridesTemplateFile - found
ToolPalettePath - found
PrinterConfigPath - found
PrinterDescPath - found; error: bad argument type: stringp nil

Command:

Если за комментировать приведенные строки - настройка проходит на ура
Я раньше этим не заморачивался, а сейчас захотелось на сети прописать настройки нестандартных форматов PDF/DWF. А не тут-то было. У тебя работает?

Makswell · 11.11.2010, 12:39

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

В итоге всё (что нужно) получилось настроить программно. Кроме групп инструментальных палитр. Как сгруппировать инструментальные палиты программно? Кто-нибудь пытался это сделать? Может непосредственной правкой файла профиля *.aws, может импортом файла *.xpg, в который заранее экспортирована группа, может ещё как-нибудь?

Krieger · 11.11.2010, 14:02

Цитата:

Сообщение от wetr

Если за комментировать приведенные строки - настройка проходит на ура
Я раньше этим не заморачивался, а сейчас захотелось на сети прописать настройки нестандартных форматов PDF/DWF. А не тут-то было. У тебя работает?

У меня работает. Проверял на всех компьютерах которые я встречал на своем пути. Это все компы в моей организации и несколько домашних. Кстати, работает и на Windows7 и на AutoCAD2009. Покажи свой файл настроек.

Цитата:

В итоге всё (что нужно) получилось настроить программно. Кроме групп инструментальных палитр. Как сгруппировать инструментальные палиты программно? Кто-нибудь пытался это сделать? Может непосредственной правкой файла профиля *.aws, может импортом файла *.xpg, в который заранее экспортирована группа, может ещё как-нибудь?

Ну я же реализовал это. У меня все настраивается. В файле настроек есть такая строка:

Код:

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

ToolPaletteProfile
\Library\Parameters\Menu\Profile.aws

А в коде это:

Код:

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

      ;;копируем профиль палитры
        (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 - не найден")
      )

Т.е. сначала настраиваешь палитры как тебе угодно вручную. Потом копируешь себе готовенький файл aws и прописываешь его адрес в файле настроек. На другом компе соответственно код после установки путей доступа скопирует этот aws куда надо. И все заработает.

Makswell · 11.11.2010, 14:20

Krieger, спасибо!

acyxou · 11.11.2010, 18:50

Цитата:

Сообщение от Makswell

В итоге всё (что нужно) получилось настроить программно. Кроме групп инструментальных палитр. Как сгруппировать инструментальные палиты программно? Кто-нибудь пытался это сделать? Может непосредственной правкой файла профиля *.aws, может импортом файла *.xpg, в который заранее экспортирована группа, может ещё как-нибудь?

Я бы не рекомендовал заморачиваться с файлом AWS. Группировать палитры очень удобно самым простым способом:
1. создать каталог ToolPalettes, в нем подкаталоги (это будут ваши подгруппы), например "ОВ", "ВК", "ГП", "АР" и т.д.;
2. далее идем в OPTIONS -> вкладка Files -> Tool Palettes Search Path, устанавливаем там один единственный путь "ваш\путь\ToolPalettes\ОВ", применяем закрываем options;
3. открываем Tool Palettes в акаде, настраиваем их в соответствии с подгруппой (ОВ), можно воспользоваться экспортом/импортом из выших уже существующих палеток;
4. затем, создаете кнопочку для данной группы палеток с макросом: ^C^CToolPalettesClose;*_toolpalettepath;"ваш\\путь\\ToolPalettes\\ОВ";ToolPalettes
5. далее повторяете пункты 2-4 для остальных папок(подгрупп) в каталоге ToolPalettes;
6. можно немножко заморочитmся и переключать палетки лиспом подобного содержания:

Код:

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

(defun C:TP_OV (/ path)
(command "_ToolPalettesClose")
(setq path
  (strcat
  ваш\\путь\\ToolPalettes\\ОВ"
 )
)
(vla-put-ToolPalettePath
(vla-get-files (vla-get-preferences (vlax-get-acad-object)))
path
)
(command "_ToolPalettes")
)

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

Krieger · 11.11.2010, 19:26

Ты наверное немного не в теме, так все и делают обычно. Файл aws сохраняет группы, вид и расположение кнопок на палитре.

acyxou · 11.11.2010, 20:20

Цитата:

Сообщение от Krieger

Файл aws сохраняет группы, вид и расположение кнопок на палитре.

и че?

wetr · 12.11.2010, 02:09

Цитата:

Сообщение от Krieger

У меня работает. Проверял на всех компьютерах которые я встречал на своем пути. Это все компы в моей организации и несколько домашних. Кстати, работает и на Windows7 и на AutoCAD2009. Покажи свой файл настроек.

path.txt

Код:

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

SupportPath
\AutoCAD\2010\settings\arx
\AutoCAD\2010\settings\cfg
\AutoCAD\2010\settings\cuix
\AutoCAD\2010\settings\lisp
\AutoCAD\2010\settings\shx
\AutoCAD\2010\settings\pltools
\AutoCAD\2010\settings\files
\AutoCAD\2010\settings\Kr_Weld
\AutoCAD\2010\settings\lin
\AutoCAD\2010\settings\app\aweld


PrinterConfigPath
\AutoCAD\2010\settings\Plotters

PrinterDescPath
\AutoCAD\2010\settings\Plotters\PMP Files

PrinterStyleSheetPath
\AutoCAD\2010\settings\PlotStyles

TemplateDwgPath
\autocad\2010\templates\sheet

SheetSetTemplatePath
\autocad\2010\templates\sheetset

QNewTemplateFile
\autocad\2010\templates\sheet\шаблон_листа.dwt

PageSetupOverridesTemplateFile
\autocad\2010\templates\sheet\шаблон_листа.dwt

ToolPalettePath
\AutoCAD\2010\settings\ToolPalette

ToolPaletteProfile
\AutoCAD\2010\settings\ToolPaletteProfile

MenuFile
\AutoCAD\2010\settings\cuix\corp_01.cuix

START.lsp

Код:

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

(load "t:\\autocad\\2010\\settings\\lisp\\kr_autosetup.lsp")
(Kr_AutoSetup "T:" "\\autocad\\2010\\settings\\cfg\\paths.txt")

Makswell · 12.11.2010, 15:24

acyxou, интересное и простое решение, не знал о таком и сам вот не додумался никак. Мне это нравится. Пожалуй, всё же возьму именно его на вооружение. Спасибо.

Krieger · 12.11.2010, 18:23

Цитата:

Сообщение от acyxou

и че?

А то, что твой способ решает проблему только с группировкой палеток, а с остальным нет.

Wetr

Цитата:

PrinterDescPath
\AutoCAD\2010\settings\Plotters\PMP Files

Убери пробел в наименовании каталога. Например:

Код:

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

\AutoCAD\2010\settings\Plotters\PMP_Files

acyxou · 12.11.2010, 21:45

Цитата:

Сообщение от Krieger

А то, что твой способ решает проблему только с группировкой палеток, а с остальным нет.

Разве это настолко принципиально!?
Не проверял лично, но полагаю, что настроив одну "группу" палеток по своему вкусу и нормально закрыв автокад, настройки палеток сохранятся в AWS файле и в следующий раз при открытии этой же группы палеток, настройки ее отображения будут восстановлены (если, конечно, создатель палеток не изменит guid).
Makswell, если будете тестировать мою теорию, то сообщите о результатах...

wetr · 13.11.2010, 02:23

Krieger, спасибо! Второй раз на те же грабли)))

Krieger · 13.11.2010, 19:02

Цитата:

Сообщение от acyxou

Разве это настолко принципиально!?
Не проверял лично, но полагаю, что настроив одну "группу" палеток по своему вкусу и нормально закрыв автокад, настройки палеток сохранятся в AWS файле и в следующий раз при открытии этой же группы палеток, настройки ее отображения будут восстановлены (если, конечно, создатель палеток не изменит guid).

Протестировал на 10 рядов уже давно. Да, если ты настроишь палетку по своему вкусу, выключишь её, перезапустишь кад и включишь вновь эту палетку, то конечно все останется на своих местах, т.к. aws файл уже модифицирован так как надо и более не менялся.
Я говорю про немного другую ситуацию. Создал палетку, настроил отображение кнопок, настроил порядок кнопочек слил её в какую нибудь группу. А теперь её же, уже настроенную, нужно установить еще на 50 компов. А потом она отредактируется, в неё добавится новые кнопки, которые должны быть где то в середине общей массы кнопок и нужно будет её снова установить на уже переустановленные кады 50-ти компов. Вручную гонять все кнопки на всех палетках, чтобы расставить их по порядку на каждом компе ну очень муторно может быть. Хотя можно скопировать aws и не париться.
Для справки. Если aws файл утерян, то порядок кнопок устанавливается в порядке их создания. Т.е. если с нуля её сделать правильно, то для этого aws будет не нужен.

Цитата:

Сообщение от wetr

Krieger, спасибо! Второй раз на те же грабли)))

А ты с aws разобрался? Судя по этому:

Код:

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

ToolPaletteProfile
\AutoCAD\2010\settings\ToolPaletteProfile

не разобрался.
В группе ToolPaletteProfile должен быть твой файл профиля палитры "Profile.aws" который будет копироваться в папку типа:

Код:

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

C:\Documents and Settings\Admin\Application Data\Autodesk\AutoCAD 2008\R17.1\enu\Support\Profiles\Unnamed Profile

См. пост №106

wetr · 14.11.2010, 03:03

Krieger, спасибо! Действительно, так группы сохраняются. Теперь совсем ничего делать не надо будет вручную

Pavel23 · 30.11.2010, 11:00

Makswell: Вот функция импорта профиля. Как она сделана у меня.
===================================================
Приветствую всех категорически!
У меня эта функция импорта профия arg. не фурычит че-то...

Команда: (load "profile_import")
PROFILE_IMPORT

Команда: (profile_import "2011.arg" "N:\\Prof_arg\\2011.arg" :vlax-true) ; ошибка: no function definition: VLAX-GET-ACAD-OBJECT

Может я чего-то не правильно делаю?
Лисп положил в Support, CAD у меня правда 2011, как бороться с этим "no function definition: VLAX-GET-ACAD-OBJECT", подскажите плиз.

TararykovDG · 30.11.2010, 11:06

Цитата:

Сообщение от Pavel23

Может просветите, че делать то.

Ответ здесь

Pavel23 · 30.11.2010, 11:28

Большое спасибо TararykovDG, все заработало

666 · 01.12.2010, 09:41

Добрый день. Вопрос Krieger. Расскажи, пожалуйста, пошагово как сделать так, чтобы твой вариант настройки палитр, на разных компах, заработал. Прошу иметь ввиду, что я не силен в подобных вещах.

Cveta · 05.05.2011, 06:19

Добрый день!Хотелось бы узнать что я делаю не правильно: 1.Я сохранила у себя код в блокноте с расширением lsp
2. Загрузила 3. Ввела команду _Kr_AutoSetup. Но пишет автокад "Неизвестная команда "KR_AUTOSETUP". Для вызова справки нажмите F1."

hwd · 05.05.2011, 07:50

варианты:
1. вы на самом деле НЕ загрузили программу
2. вы загрузили НЕ ТУ программу
3. вы загрузили ту программу, но в коде не определено функции с обозначенным вами именем.
4. в исходном коде ошибка, в следствии которой ваш файл не грузится.
5. у вас AutoCAD LT.

В любом случае вряд ли вашего пациента вылечат по фотографии (т.е. не видя вашего кода и без уточнения - как именно вы загружаете этот файл).

gomer · 05.05.2011, 08:03

Возможно необходимо было ввести в кс (KR_AUTOSETUP)

hwd · 05.05.2011, 08:34

Цитата:

Сообщение от gomer

Возможно необходимо было ввести в кс (KR_AUTOSETUP)

п.3

Krieger · 05.05.2011, 14:28

Цитата:

Сообщение от Cveta

Добрый день!Хотелось бы узнать что я делаю не правильно: 1.Я сохранила у себя код в блокноте с расширением lsp
2. Загрузила 3. Ввела команду _Kr_AutoSetup. Но пишет автокад "Неизвестная команда "KR_AUTOSETUP". Для вызова справки нажмите F1."

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

Цитата:

Сообщение от 666

Добрый день. Вопрос Krieger. Расскажи, пожалуйста, пошагово как сделать так, чтобы твой вариант настройки палитр, на разных компах, заработал. Прошу иметь ввиду, что я не силен в подобных вещах.

Извиняюсь за запоздалый ответ. Почему-то не узнал о сообщении. Посмотри здесь:
http://forum.dwg.ru/showpost.php?p=451629&postcount=84

hwd · 05.05.2011, 14:32

млин... с утра невнимательно посмотрел (видимо не проснулся), принял сообщение Cveta как первый пост топика... А оно оказывается аж #122, да и код выложен (страниц много, я принял её за первую)...

gomer · 05.05.2011, 19:07

Цитата:

Сообщение от Krieger

В коде нет команд, там функция, а функция запускается в скобочках с необходимыми параметрами

А я угадал, угадал

ну, почти...

Cveta · 06.05.2011, 11:05

У меня не получилось.Я ввела команду: (Kr_AutoSetup "С:" "\\autocad\\setting\\tamplatt\\Kr_Paths.txt")
но автокад написал:
Файл настроек С:\autocad\setting\tamplatt\Kr_Paths.txt не найден

Мне надо, чтоб пути на шаблон сами прописывались. Порядок действий был такой:
Я взяла рабочий код в посту 85. Сохранила его с названием "Kr_AutoSetup.lsp" в папку: C:\autocad\setting\tamplatt.

В эту же папку положила шаблон "Шаблоны листов ИПСП_форма4.dwt"
и файл настроек "Kr_Paths.txt

В файле настроек "Kr_Paths.txt" пути изменила :
TemplateDwgPath
\autocad\setting\tamplatt

QNewTemplateFile
\autocad\setting\tamplatt\Шаблоны листов ИПСП_форма4.dwt

Затем загрузила и ввела команду. Почему не получается?

Krieger · 06.05.2011, 12:36

Да вроде правильно все. Не знаю почему функция findfile не нашла файл настроек, если он действительно там был.

Попробуйте разместить файл настроек здесь:
"C:\Documents and Settings\<имя пользователя>\Application Data\Autodesk\AutoCAD 2008\R17.1\enu\Support\"

И в названии шаблона уберите пробелы.

Cveta · 23.05.2011, 10:37

Добрый день. Разместила шаблон, файл настроек и Kr_AutoSetup.lsp в папке C:\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Support.
В названии шаблона убрала пробелы: Шаблоны_листов_ИПСП_форма4_изм.dwt. В файле настроек путь изменила :
TemplateDwgPath
\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Support

QNewTemplateFile
\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Supportt\Шаблоны_листов_ИПСП_форма

Загрузила и ввела команду: (Kr_AutoSetup "С:" "Documents and Settings\\nisvevl\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\rus\\Support\\Kr_Paths.txt") .
Автокад пишет: Команда: _appload Kr_AutoSetup.lsp успешно загружено.
Команда:
Команда:
Команда: (Kr_AutoSetup "С:" "Documents and Settings\\nisvevl\\Application
Data\\Autodesk\\AutoCAD 2008\\R17.1\\rus\\Support\\Kr_Paths.txt")
Файл настроек С

ocuments and Settings\nisvevl\Application
Data\Autodesk\AutoCAD 2008\R17.1\rus\Support\Kr_Paths.txt не найден
Что делать? Заранее спасибо.

Krieger · 23.05.2011, 15:12

Цитата:

Сообщение от Cveta

Добрый день. Разместила шаблон, файл настроек и Kr_AutoSetup.lsp в папке C:\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Support.
В названии шаблона убрала пробелы: Шаблоны_листов_ИПСП_форма4_изм.dwt. В файле настроек путь изменила :
TemplateDwgPath
\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Support

QNewTemplateFile
\Documents and Settings\nisvevl\Application Data\Autodesk\AutoCAD 2008\R17.1\rus\Supportt\Шаблоны_листов_ИПСП_форма

Загрузила и ввела команду: (Kr_AutoSetup "С:" "Documents and Settings\\nisvevl\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\rus\\Support\\Kr_Paths.txt") .
Автокад пишет: Команда: _appload Kr_AutoSetup.lsp успешно загружено.
Команда:
Команда:
Команда: (Kr_AutoSetup "С:" "Documents and Settings\\nisvevl\\Application
Data\\Autodesk\\AutoCAD 2008\\R17.1\\rus\\Support\\Kr_Paths.txt")
Файл настроек С

ocuments and Settings\nisvevl\Application
Data\Autodesk\AutoCAD 2008\R17.1\rus\Support\Kr_Paths.txt не найден
Что делать? Заранее спасибо.

Поставь двойной слеш перед "Documents and Settings":
(Kr_AutoSetup "С:" "\\Documents and Settings\\nisvevl\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\rus\\Support\\Kr_Paths.txt")
Если не сработает, попробуй так ввести в комстроке со скобками:
(findfile "Kr_Paths.txt")
что выдаст? Если выдаст заветную строку, то попробуй так:
(Kr_AutoSetup "" "Kr_Paths.txt")

Cveta · 24.05.2011, 07:01

Цитата:

что выдаст? Если выдаст заветную строку, то попробуй так:
(Kr_AutoSetup "" "Kr_Paths.txt")

Автокад пишет:Команда: (findfile "Kr_Paths.txt")
"C:\\Documents and Settings\\nisvevl\\Application Data\\Autodesk\\AutoCAD
2008\\R17.1\\rus\\support\\Kr_Paths.txt"
Команда: (Kr_AutoSetup "" "Kr_Paths.txt")
; ошибка: неверный тип аргумента: FILE nil

Krieger · 24.05.2011, 15:14

Цитата:

Сообщение от Cveta

Автокад пишет:Команда: (findfile "Kr_Paths.txt")
"C:\\Documents and Settings\\nisvevl\\Application Data\\Autodesk\\AutoCAD
2008\\R17.1\\rus\\support\\Kr_Paths.txt"
Команда: (Kr_AutoSetup "" "Kr_Paths.txt")
; ошибка: неверный тип аргумента: FILE nil

Тогда так:
(Kr_AutoSetup "Kr_" "Paths.txt")

4ydik · 13.10.2011, 11:12

Добрый день, появился такой вопрос: Как с помощью lisp добавить значение в Сервис >> Настройка>> Переходим на закладку Файлы и раскрываем список Путь доступа к вспомогательным файлам. Путь к определенной папке где лежат файлы с динамическими блоками?

Александр Ривилис · 13.10.2011, 11:49

Код:

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

 (setenv "ACAD" (strcat (getenv "ACAD") ";" "дополнительный путь"))

"дополнительный путь" должен существовать!

Кулик Алексей aka kpblc · 13.10.2011, 11:49

(setenv "ACAD" (strcat (getenv "ACAD") ";" <Путь>)
Только надо не забыть проверить - вдруг там этот путь уже есть...

4ydik · 13.10.2011, 11:55

Большое спасибо!!!!

crosandr · 01.02.2012, 12:16

Krieger, может в шапку занесешь актуальную версию, чтоб не собирать ее по всем веткам?

Krieger · 02.02.2012, 14:39

Цитата:

Сообщение от crosandr

Krieger, может в шапку занесешь актуальную версию, чтоб не собирать ее по всем веткам?

Он собран в посте №85. Однако перенес код в шапку.

wetr · 04.06.2012, 09:43

Недавно озадачился проблемой актуализации настроек автокада на домашних компах пользователей.
На сервере в папке настроек автокада постоянно, что-то меняется. В палитрах блоки добавились. Лиспы, системные переменные, шаблоны и ....
Почти все со временем улучшается. А так как программная настройка автокада завязана на локальную сеть института, то домашние компы сидят с давно устаревшими настройками.
Пока так вышел из положения:
залил папку с настройками на Облачный диск Dropbox.com. (Можно воспользоваться любым другим, не принципиально).
Установил на работе и дома клиентскую программу, которая автоматом синхронизирует папки. У меня заработало. Вот только осталось объяснить пользователям, как это им сделать(((

VVA · 05.06.2012, 10:51

wetr, Мы отказались от использования абсолютных путей при размещении информации на серверах. При входе пользователя в домен у нас автоматом исполняется некий bat файл, который с использованием net use монтирует сетевой диск ( net use O: \\Storage\Projects /persistent:yes ). Это на работе. Дома такой же эффект можно получить используя subst (subst O: "D:\WORK"). Осталось только переписать папку с сервера на локальный диск в D:\WORK

wetr · 06.06.2012, 09:08

у нас тоже сетевой диск монтируется. Но без дополнительного батников. Просто в папке Сервис-Смонтировать сетевой диск-Восстанавливать при входе в систему. Пока работает. Бывают конечно сбои, но не смертельно. Раз в год можно заново прописать сетевой диск.
Дома также папку C:\Documents and Settings\user\Dropbox прописал как сетевой диск и вуаля! Одну и ту же букву назначил (у нас T), потом лисп:

Код:

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

 (load "t:\\autocad\\2010\\settings\\lisp\\kr_autosetup.lsp")
(Kr_AutoSetup "T:" "\\autocad\\2010\\settings\\cfg\\paths.txt")

загрузил, и все

Цитата:

Осталось только переписать папку с сервера на локальный диск в D:\WORK

вобщем-то этого я и хотел избежать, всеми этими облачными технологиями. Лень - двигатель прогресса)))

VVA · 06.06.2012, 13:48

Цитата:

Сообщение от wetr

у нас тоже сетевой диск монтируется...

Цитата:

Сообщение от wetr

Вот только осталось объяснить пользователям, как это им сделать(((

Тогда чего уж проще?
1. Из облака или с флешки переписать содержимое в известную папку
2. Запустить bat (или добавить в автозагрузку)(subst Т: "C:\Documents and Settings\user\Dropbox")
Кроме того сам процесс переписывания с флэшки (а может и из облака) можно автоматизировать. Есть портативная редакция Allway Sync 'n' Go для инсталляции на USB устройство

crosandr · 13.07.2012, 10:35

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

Код:

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

 (strcat	FirstPath
	(Kr_FindTextFileNextString (strcat FirstPath PathFile) "TemplateDwgPath")
)

, поскольку функция Kr_FindTextFileNextString возвращает nil при невозможности обнаружить соответствующую запись в файле настроек

Krieger · 13.07.2012, 13:18

Можно исключать все что угодно. Ну вернет nil, ну да и фиг с ней, дальше работать будет. Программа не ругается, а просто говорит чего нашла и что прописала, а что нет. Она же не обрывается на этом... Не обращай внимания.

wetr · 05.12.2012, 08:45

Krieger, привет.
А как добавить в в автоматическую загрузку несколько cui-файлов.
Я постоянно подгружаю, вручную PLTools и VetCAD
Можно их просто следом прописать после

Код:

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

 
MenuFile
\Library\Parameters\Menu\Krieger.cui

?

Krieger · 05.12.2012, 12:09

Если просто пропишешь следом, ничего не получится. Загрузится только первый и то, если он будет находиться по указанному адресу. Я так понимаю они у тебя в другом месте находятся. Нужно код переписывать (дописывать).

wetr · 06.12.2012, 02:36

Ну тогда запиши в Wish-лист)))
Чтобы было все красиво, надо сделать графический интерфейс, чтобы можно было выбирать, какое меню загружать.

Shoorup · 23.04.2014, 13:08

Что-то я не вкурил до конца данный лисп.
Мне нужно сделать некий батник или нечто подобное, чтобы автоматом прописывало (создавало новый): "Путь доступа к вспомогательным файлам" и путь к "Корпоративный файл адаптации". Как?

Krieger · 23.04.2014, 13:34

Нужно создать файл Kr_Paths.txt, в котором все пути прописаны, сохранить его, например по адресу D:\Library\Parameters\Menu\Kr_Paths.txt"
Выполнить функцию в каде Kr_AutoSetup с адресом файла Kr_Paths.txt, например: (Kr_AutoSetup "D:" "\\Library\\Parameters\\Menu\\Kr_Paths.txt")

Shoorup · 23.04.2014, 14:10

А прописать пути без запуска AutoCAD можно? Или только через lisp?

Krieger · 23.04.2014, 14:17

Наверное можно, как - не знаю. Мой способ через лисп.

gomer · 23.04.2014, 14:18

Цитата:

Сообщение от Krieger

Наверное можно, как - не знаю.

через консоль

Shoorup · 23.04.2014, 17:23

Цитата:

Сообщение от gomer

через консоль

может возможно vbs накидать... А где хранятся эти пути? В реестре вроде нет...

gomer · 23.04.2014, 18:35

Цитата:

Сообщение от Shoorup

может возможно vbs накидать...

Думаю можно, видел семинар, где кажется А. Ривилис рассказывал о крутости консоли, когда она только появилась

Danil77 · 14.10.2014, 15:00

Цитата:

Сообщение от Krieger

Нужно создать файл Kr_Paths.txt, в котором все пути прописаны, сохранить его, например по адресу D:\Library\Parameters\Menu\Kr_Paths.txt"
Выполнить функцию в каде Kr_AutoSetup с адресом файла Kr_Paths.txt, например: (Kr_AutoSetup "D:" "\\Library\\Parameters\\Menu\\Kr_Paths.txt")

Ребята, не сочтите за наглость.. Но..
Дайте пожалуйста txt-файлик и инструкции по его запуску.
В котором будет достаточно прописать сетевой путь.
Задача - дать пользователям этот файл и инструкцию по запуску, чтобы прописать на компьютерах путь к общим Инструментальным палитрам.
Палитру будет использовать только для блоков. Создание палитры и блоков осилено. Осталось прописать пути)

АлексЮстасу · 12.07.2015, 16:58

Как вариант подхода и решения.
Мы сделали приложение к AutoCAD Map 3d (параллельно аналогичное и под базовый AutoCAD) со встроенной автоматической загрузкой значений нужных переменных Автокада и автоматической загрузкой ресурсов.
В нашем приложении используется текстовый файл описания переменных, путей и названий файлов ресурсов и описаний параметров черчения всех объектов нужного стандарта.
Приложение предназначено для обеспечения черчения в нужном стандарте. Поэтому пользователю нужно обеспечить постоянную поддержку настроек Автокада и постоянный доступ к ресурсам.
Загружаются не только нужные слои, типы линий, текстовые стили, описания блоков, размерных стилей, стилей мультивыносок, но и стили мультилиний, и описания штриховок.
Автоматические загрузки производятся при загрузке файла описания стандарта черчения, при обновлении загрузки файла описания и при выборе из списка объектов любого объекта.

https://youtu.be/Iz8y4fTN9So - загрузка нужных значений переменных AutoCAD, ресурсов черчения из указанный источников при загрузке файла описания объектов.
https://youtu.be/aWd1NDupTcQ - автоматическая загрузка нужных значений переменных AutoCAD, ресурсов черчения после _PURGE, в новый открытый dwg.

Т.е. полный _PURGE не лишает пользователя возможности чертить с заданными параметрами - они автоматически восстанавливаются.
Загружаются только те слои, блоки и пр. из всех, описанных в указанных файлах ресурсов, которые нужны для черчения в нужном стандарте.
При загрузке или перезагрузке файла описания объектов загружаются все нужные для черчения ресурсы для всех объектов выбранного стандарта черчения.
При выборе объекта из списка загружаются только нужные для его черчения ресурсы.

Krieger · 12.07.2015, 20:38

Мой код настраивает несколько другую вещь. Т.е. не настройки чертежа, а настройки самого AutoCAD, которые, например, нужны для последующего выполнения программ (такой как у тебя) по поддержанию стандарта.

АлексЮстасу · 12.07.2015, 22:44

Цитата:

Сообщение от Krieger

Мой код настраивает несколько другую вещь. Т.е. не настройки чертежа, а настройки самого AutoCAD, которые, например, нужны для последующего выполнения программ (такой как у тебя) по поддержанию стандарта.

Я и не для отрицания или критики. А как продолжение темы. Как вариант для других условий.
(Год назад создал тему с идеей программной загрузки настроек, а меня сходу послали именно сюда).
Задание значений переменных - тоже настройка AutoCAD.

Доб.: именно Вы и послали сюда

Krieger · 13.07.2015, 05:38

Цитата:

Сообщение от АлексЮстасу

Доб.: именно Вы и послали сюда

Дай ссылку )

АлексЮстасу · 13.07.2015, 14:44

Цитата:

Сообщение от Krieger

Дай ссылку )

http://forum.dwg.ru/showthread.php?t=111669

Krieger · 13.07.2015, 18:09

Загружать все и вся в чертеж, мне думается не совсем правильно. Все должно грузиться по мере необходимости во время работы. Если какая то программа использует какие то слои, типы линий, стили, блоки, то она должна уметь это все подгружать/создавать сама.

АлексЮстасу · 13.07.2015, 19:04

Цитата:

Сообщение от Krieger

Загружать все и вся в чертеж, мне думается не совсем правильно. Все должно грузиться по мере необходимости во время работы. Если какая то программа использует какие то слои, типы линий, стили, блоки, то она должна уметь это все подгружать/создавать сама.

В принципе согласен, что, загрузив все в чертеж, делаем его тяжелым. И выбирать вручную из длинных списков слоев, блоков и т.п. труднее. Но в целом не замечал еще особых проблем. Мы с шаблонами со всеми описаниями всего нужного уже почти десять лет работаем.
Подгрузка нужного для черчения только конкретного объекта у нас есть - вариант после полного _PURGE и без Reload. Но это для черчения из приложения. А если нужно начертить что-то обычными средствами, то сразу возникает лишняя работа и большая вероятность несоответствия стандарту, если в файле нет описаний всего нужного.

В приложении никаких слоев и пр. не прописывается - она считывает все нужное в файле описания, и подгружает это из указанных dwg, lin, dwt, pat и т.п. Число файлов, из которых нужно подгружать не ограничено, и еще можно использовать маски вроде *.dwg - например, если блоки описаны в какой-то папке каждый в отдельном файле.
Т.е. в приложении ничего не "прошито", возможности для пользователя не ограничены - что он укажет в файле описания, то и возьмется. Предмет черчения, соответственно, любой, стандарт черчения тоже.

Да, ранее забыл написать, что Layout-ы тоже загружаем.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Рифмоплетство.	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