[Startrek]

Уважаемые коллеги!
Кто-нибудь пробовал с помощью VLISP-a устанавливать Enterprise CUI ??
У меня ничего не получилось.
Может кто делал что-то подобное?

[_Andre_]

Вроде получается так:

Код:

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

(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) x  )

x - путь к папке где лежит cui-файл

200 с лишним компьютеров 2007 -2008 акады и вертикальные приложения, на всех загружается.

[Startrek]

Большое спасибо.
Сейчас попробую

[Startrek]

Попробовал - работает частично создае и присоединяет , но вот в мену не появляется

Код:

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

(defun c:entload ()
(vl-load-com)
(setq x (getfiled "Enterprise CUI Location" "c:/" "cui" 8))
(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) x  )
(princ)
)

[Александр Бауск]

Господи, как же я отстал от жизни.

[Startrek]

Ну бог тут ни причем. А по делу? Я ведь совсем заморочился - ну ни сместа....а надо, ходить от компа к компу и делать ручками ЗАМОРДОВАЛСЯ, а автоматом люди сами будут делать..........

[Startrek]

Bо -погоняйте вроде работает, но пока тока в 2008.
У КОГО-НИТЬ ЕСТЬ идеикак улучшить.

Код:

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

(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  )
(setq lok1 x)
;(setq lok1 (getfiled word "c:/Documents and Settings/" mn 8))
(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) 
(princ)
)

[Startrek]

Bо -погоняйте вроде работает, но пока тока в 2008.
У КОГО-НИТЬ ЕСТЬ идеикак улучшить.

Код:

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

(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  )
(setq lok1 x)
;(setq lok1 (getfiled word "c:/Documents and Settings/" mn 8))
(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) 
(princ)
)

[Makswell]

Если я правильно понял...

Я делаю так.
Всё настраиваю руками (включая путь к Enterprise cui) и применяю функцию, которая экспортирует профиль в arg-файл:

Код:

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

;;; ************************************************************************
;;; <<<ВОЗВРАЩАЕМОЕ ЗНАЧЕНИЕ>>>
;;; t-профиль сохранен, nil - не сохранен
;;;
;;; ************************************************************************
;;; <<<АРГУМЕНТЫ>>>
;;; Profile - имя профиля (строка)
;;; RegFile - имя arg-файла, в который сохраняется профиль (с путем к нему) (строка)
;;;
;;; ************************************************************************
;;; <<<ПРИМЕРЫ>>>
;;; (m-profile-save "M-CAD2008" "D:\\M-CAD\\Support\\M-CAD2008.arg")
;;;
;;; или лучше так:
;;; (m-profile-save
;;;   "M-CAD2008"
;;;   (strcat "D:"
;;; 	  (chr 92)
;;; 	  "M-CAD"
;;; 	  (chr 92)
;;; 	  "Support"
;;; 	  (chr 92)
;;; 	  "M-CAD2008.arg"
;;;   )
;;; )
;;;
;;; ************************************************************************

(defun m-profile-save
		      (Profile		RegFile		 /
		       preferences	profiles	 RegFile
		       ExportProfile	profiles_list	 temp
		       GetAllProfileNames		 profiles_list_temp
		      )
  (setq preferences (vla-get-Preferences (vlax-get-acad-object)))
  (setq profiles (vla-get-profiles preferences))
  (setq GetAllProfileNames (vla-GetAllProfileNames profiles 'temp))
  (setq profiles_list (vlax-safearray->list temp))
  (foreach item	profiles_list
    (setq profiles_list_temp (append profiles_list_temp (list (strcase item))))
  )
  (setq profiles_list profiles_list_temp)
  (if (member (strcase Profile) profiles_list)
    (progn
      (setq ExportProfile
	     (vlax-invoke-method
	       profiles
	       'ExportProfile
	       Profile
	       RegFile
	     )
      )
      t
    )
    nil
  )
)

Потом в нужный момент применяю функцию, которая импортирует профиль из файла и устанавливает его текущим:

Код:

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

;;;Аргументы:
;;;Profile - новое имя профиля 
;;;RegFile - имя файла с расширением arg
;;;key - включение пути
;;;	:vlax-true - включает в профиль пути поддержки, определённые в arg-файле
;;;	:vlax-false - Не включает в профиль пути поддержки, определённые в arg-файле
;;;пример вызова:
;;;(m-profile_import "M-CAD2008" "D:\\M-CAD\\Support\\M-CAD2008.arg" :vlax-true)
(defun m-profile_import
			(Profile_Name	      RegFile
			 key		      /
			 M-vla_Preferences    M-vla_PreferencesProfiles
			 RegFile	      Import_Profile
			 ActiveProfile	      M-vla_Application
			)
  (setq M-vla_Application (vlax-get-acad-object))
  (setq M-vla_Preferences (vla-get-Preferences M-vla_Application))
  (setq M-vla_PreferencesProfiles (vla-get-profiles M-vla_Preferences))
  (setq ActiveProfile (vla-get-ActiveProfile M-vla_PreferencesProfiles))
  (vla-CopyProfile M-vla_PreferencesProfiles ActiveProfile "M-Profile_temp")
  (setq	ActiveProfile
	 (vla-put-ActiveProfile
	   M-vla_PreferencesProfiles
	   "M-Profile_temp"
	 )
  )
  (setq	Import_Profile
	 (vlax-invoke-method
	   M-vla_PreferencesProfiles 'ImportProfile Profile_Name RegFile key)
  )
  (setq	ActiveProfile
	 (vla-put-ActiveProfile M-vla_PreferencesProfiles Profile_Name)
  )
  (vla-DeleteProfile M-vla_PreferencesProfiles "M-Profile_temp")
)

[Startrek]

Ну вот вроде все работает, правда Error Handling пока нет и присказка на английском, так как на местые условия расчитана.

Код:

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

;;------------------------------------------------------------------------------------------------------------------------
;;BTN Better Than Nothing AutoLISP, by Leonid Nemirovsky                            October 2008
;;
;;Run program, brows 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 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  )
(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) 
(princ)
)

[acyxou]

А как сделать чтоб Enterprise CUI меню появлялось с конца, т.е. после меню Help, а не перед меню File?

[Sleekka]

А подскажите пожалуйста что такое Enterprise CUI?

[acyxou]

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

[Sleekka]

Спасибо, даже с картинкой

[acyxou]

Кто-нибудь знает как программно загрузить main menu, причем чтоб путь был Ralative. Поясню.... Есть системная переменная, которая отвечает за Main menu

Код:

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

(getenv "MenuFile")

соответственно, и изменить ее можно следующим образом:

Код:

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

(setenv "MenuFile" "C:\\Documents and Settings\\USER\\Application Data\\Autodesk\\AutoCAD 2008\\R17.1\\enu\\Support\\Custom")

. А теперь, внимание, вопрос: каким образом можно указать на этот Custom.cui так, чтоб он НЕ был привязан к имени учетной записи пользователя, т.е. в данном примере "USER".
Рассмотрю все варианты, не обязательно зацикливаться на данной переменной. Мне в другой ветке подсказали как программно установить Enterprise cui посредством этого кода:

Код:

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

(vl-load-com)(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "\\\\Server\\proekts\\AutoCAD_Resources\\acad" )

. Вероятно возможно то же самое проделать и с Main menu?

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

Теоретически можно, только надо будет использовать vla-put-MenuFile вместо vla-put-EnterpriseMenuFile

[acyxou]

Помогите, пожалуйста, с кодом
Проблема вот в чем: имею созданное и отредактированное Enterpise cui в 2009-ом автокаде, при загрузке его в 2008-ой автокад, многие кнопки показываются вопросиками, т.е. Autocad 2008 не может найти иконки, присвоенные 2009-ым автокадом. Решение нашел таким способом, что при загрузке Enterprise cui будет идти проверка на версию автокада.... Если 2008-ой и ниже, то EnterpriseCui2008.cui, если 2009-ый, то соответственно, EnterpriseCui2008.cui.
Вот только я в лиспе не очень-то пока силен. Вот отдельный код на проверку версии акада:

Код:

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

(atof (substr (getvar "ACADVER") 1 4))

А вот на установку Enterprise cui:

Код:

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

(vla-put-EnterpriseMenuFile (vla-get-files (vla-get-Preferences (vlax-get-acad-object))) "\\\\Server\\proekts\\AutoCAD_Resources\\EnterpriseCui2008" )

А как их связать вместе у меня что-то не получается.... Помогите пожалуйста.
Кстати, если есть более рациональное решение данной проблемы, то буду рад выслушать. Заранее спасибо

[acyxou]

Я вроде сам справился

Код:

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

(vl-load-com)
(defun whatAcadVer (/)
  (if (= 17.2 (atof (substr (getvar "ACADVER") 1 4)))
    (vla-put-EnterpriseMenuFile
      (vla-get-files (vla-get-Preferences (vlax-get-acad-object)))
      "\\\\Server\\proekts\\AutoCAD_Resources\\ArhMC_Enterprise2009"
    )
    (vla-put-EnterpriseMenuFile
      (vla-get-files (vla-get-Preferences (vlax-get-acad-object)))
      "\\\\Server\\proekts\\AutoCAD_Resources\\ArhMC_Enterprise2008"
    )
  )
)

Кто-то говорил, что как только выкладываешь свою просьбу сюда, то мозг сразу начинает работать в 2 раза лучше, и сам быстро находишь нужное решение.... Он был прав

[Holon]

Сообщение от Startrek Ну вот вроде все работает, правда Error Handling пока нет и присказка на английском, так как на местые условия расчитана. Код: [Выделить все] ;;------------------------------------------------------------------------------------------------------------------------ ;;BTN Better Than Nothing AutoLISP, by Leonid Nemirovsky October 2008 ;; ;;Run program, brows 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 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 ) (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) (princ) )

Переменные надо объявить, а то они у тебя все глобальные, черевато последствиями

[Startrek]

Сообщение от Holon Переменные надо объявить, а то они у тебя все глобальные, черевато последствиями

OK - ЗАБЫЛ, УЧТУ