[Startrek]

Уважаемые коллеги!
В муках и с вашей поддержкой родилась програмка по установке автоматом профиля и Ентерпризе меню.

Код:

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

;;------------------------------------------------------------------------------------------------------------------------
;;BTN Better Than Nothing AutoLISP, by Leonid Nemirovsky                            October 2008
;;
;;Run program, go to the folder where partial CUI and all corresponding files are located
;;such as mnl, dcl etc. Select CUI file. The rest is automatic. Program will attach selected
;;CUI as Enterprise menu an will create new profile so everything will work properly.
;;Pease note that you MUST have <<Unnamed Profile>> if you for some reason do not have
;;one (AutoCAD should creat it when installed) please create profile and name it 
;;<<Unnamed Profile>> before iusing this program. 
;;PROVIDED AS IS - no warranties of any kind. Tested in AutoCAD 2008/2009
;;------------------------------------------------------------------------------------------------------------------------
(DEFUN *ERROR* (MSG)
(PRINC MSG)
(TERPRI)
(SETVAR "CMDECHO" CMD)
)
(defun c:lprofent ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)
(setq acadobject (vlax-get-Acad-Object)) 
(setq acadprefs (vla-get-preferences acadobject)) 
(setq acadprofiles (vla-get-profiles acadprefs)) 
(vlax-dump-object acadprofiles T) 
;;-----------------------------------------------------------------------------------------------------------------------
(setq x (getfiled "Enterprise CUI Location" "c:/" "cui" 8))
(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) x)
(if
(= x nil)
(progn
(setvar "cmdecho" cmd)
(exit)
)
)
(setq lok1 x)
(setq lgt (strlen lok1))
(setq aa (substr lok1 1 (- lgt 4)))
(setq lgtaa (strlen aa))
(setq count (- lgtaa 1))
(setq chk "0")
(while
(/= chk "\\")
  (setq chk (substr aa lgtaa 1))
    (cond
     ((/= chk "\\")(setq count (- count 1))  (setq lgtaa (- lgtaa 1)))
     ((= chk "\\")(setq bb (substr aa (+ 2 count))))
    )
)

(setq bb (strcase bb))
(setq cc (strcase (strcat bb "-PROFILE")))

(setq ACAD1 (strcat ";" (substr aa 1 lgtaa)))
;;-----------------------------------------------------------------------------------------------------------------------
(vla-put-ActiveProfile acadProfiles "<<Unnamed Profile>>") 
(setq ACAD2 (getenv "ACAD")) 
(setq ACAD3 (strcat acad2 ACAD1)) 
(setq prname (getvar "cprofile")) 
(vlax-invoke-method acadProfiles 'CopyProfile prname cc) 
(vla-put-ActiveProfile acadProfiles cc) 
(setenv "ACAD" ACAD3) 
(setvar "cmdecho" cmd)
(princ)
)

Теперь хотелось бы и добавить програмно OPTIONS>Files>Printer SupportFile Path>Plot Style Table Search Path
Да вот не очень я силен в VLISP.Подкиньте идею как все это провернуть ????

[Startrek]

Что коллеги... никаких идей????????

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

Посмотри

Код:

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

(vlax-dump-Object (vla-get-files (vla-get-Preferences (vlax-get-acad-object))))

[Makswell]

Соответственно в этом дампе посмотри свойство PrinterStyleSheetPath

[Startrek]

Спасибо огромное - ПОКОПАЮСЬ

[Startrek]

Эх не совсем то.... как закинуть, спасибо вам, ПОНЯЛ

Код:

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

(vla-put-PrinterStyleSheetPath (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) PAT)

А вот как ПУТЬ к ctb фаилам вынуть из
(setq PAT (getfiled "Listing of ctb:" "" "" 8))
чтоб не печатать руками ?????? substring ????

[VVA]

Startrek,

Код:

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

(if (setq PAT (getfiled "Listing of ctb:" "" "ctb" 8))
  (VL-FILENAME-DIRECTORY pat)
  )

[Startrek]

НУ ПРЕОГРОМНОЕ СПАСИБО - то что "доктор прописал".
А то я совсем зациклился и такого простого решения не видел С П А С И Б О

[Startrek]

Спасибо всем огромнейшее...
теперь все путем - работает как хотелось с самого начала
С П А С И Б О

Код:

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

;;------------------------------------------------------------------------------------------------------------------------
;;BTN Better Than Nothing AutoLISP, by Leonid Nemirovsky                            October 2008
;;
;;Run program, go to the folder where partial CUI and all corresponding files are located
;;such as mnl, dcl etc. Select CUI file. The rest is automatic. Program will attach selected
;;CUI as Enterprise menu an will create new profile so everything will work properly.
;;Pease note that you MUST have <<Unnamed Profile>> if you for some reason do not have
;;one (AutoCAD should creat it when installed) please create profile and name it 
;;<<Unnamed Profile>> before iusing this program. 
;;PROVIDED AS IS - no warranties of any kind. Tested in AutoCAD 2008/2009
;;------------------------------------------------------------------------------------------------------------------------
(DEFUN *ERROR* (MSG)
(PRINC MSG)
(TERPRI)
(SETVAR "CMDECHO" CMD)
)
(defun c:lprofent ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(vl-load-com)
(setq acadobject (vlax-get-Acad-Object)) 
(setq acadprefs (vla-get-preferences acadobject)) 
(setq acadprofiles (vla-get-profiles acadprefs)) 
(vlax-dump-object acadprofiles T) 
;;-----------------------------------------------------------------------------------------------------------------------
(setq x (getfiled "Enterprise CUI Location" "" "cui" 8))
(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) x)
(if
(= x nil)
(progn
(setvar "cmdecho" cmd)
(exit)
)
)
(setq lok1 x)
(setq lgt (strlen lok1))
(setq aa (substr lok1 1 (- lgt 4)))
(setq lgtaa (strlen aa))
(setq count (- lgtaa 1))
(setq chk "0")
(while
(/= chk "\\")
  (setq chk (substr aa lgtaa 1))
    (cond
     ((/= chk "\\")(setq count (- count 1))  (setq lgtaa (- lgtaa 1)))
     ((= chk "\\")(setq bb (substr aa (+ 2 count))))
    )
)

(setq bb (strcase bb))
(setq cc (strcase (strcat bb "-PROFILE")))

(setq ACAD1 (strcat ";" (substr aa 1 lgtaa)))
;;-----------------------------------------------------------------------------------------------------------------------
(vla-put-ActiveProfile acadProfiles "<<Unnamed Profile>>") 
(setq ACAD2 (getenv "ACAD")) 
(setq ACAD3 (strcat acad2 ACAD1)) 
(setq prname (getvar "cprofile")) 
(vlax-invoke-method acadProfiles 'CopyProfile prname cc) 
(vla-put-ActiveProfile acadProfiles cc) 
(if (setq PAT (getfiled "Select any Plot Configuration file from proper folder <ctb>" "" "ctb" 8))
(setq pat1 (VL-FILENAME-DIRECTORY pat))
)
(vla-put-PrinterStyleSheetPath (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) PAT1)
(setenv "ACAD" ACAD3) 
(setvar "cmdecho" cmd)
(princ)
)