helmer 发表于 2022-7-6 06:39:17

Check if a profile exist, copy

Hi!
 
I am trying to figure out how to make a lisp that does the following:
 
1. Check if a profile with a given name (eg. Engineering) exist in AutoCAD
2. If the profile exist it should be set active
3. If the profile does not exist the active profile should be copied and named "Engineering" and set active.
 
I have tried to put together some code from several sites and I have this:
 

(vl-load-com);get profiles from AutoCAD(vlax-invoke-method acadProfiles 'GetAllProfileNames 'profilelist);convert the list(setq profilelist (vlax-safearray->list profilelist));check if the profile exist(if (not (member "Engineering" profilelist));if it does'n exist(progn   ;copy active profile and rename to "Engineering"(vlax-invoke-method acadProfiles 'CopyProfile actProfile "Engineering") ));set "Engineering" as active profile(vla-put-ActiveProfile acadProfiles "Engineering")
 
BUT, it doesn't work.
 
Can anyone help me out?

Tharwat 发表于 2022-7-6 06:43:26

Welcome to CadTutor
 
Hope this would help you with it .
 

(defun c:Test (/ Pfs lst) ;;--- Tharwat 25. April. 2013 ---;; (setq Pfs (vla-get-Profiles             (vla-get-Preferences (vlax-get-acad-object))         ) ) (vla-GetAllProfileNames Pfs 'lst) (if (not       (member "Engineering" (vlax-safearray->list lst))   )   (progn   (vla-copyprofile       Pfs       (vla-get-activeprofile Pfs)       "Engineering"   )   (vla-put-activeprofile Pfs "Engineering")   )   (vla-put-activeprofile Pfs "Engineering") ) (princ))(vl-load-com)

helmer 发表于 2022-7-6 06:46:24

Thank you for your fast reply. But I couldn't get it to work. There are no errors in AutoCAD but it doesn't copy the current profile (which is "Unnamed Profile").

Tharwat 发表于 2022-7-6 06:49:26

Actually it should do , did you check the profiles tab in the options ?

Lee Mac 发表于 2022-7-6 06:53:24

Try this:

(defun c:setprofile ( / lst prf prn )   (setq prn "Engineering"         prf (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))   )   (vla-getallprofilenames prf 'lst)   (setq lst (vlax-safearray->list lst))   (if (member prn lst)       (vla-put-activeprofile prf prn)       (progn         (vla-copyprofile prf (getvar 'cprofile) prn)         (vla-put-activeprofile prf prn)       )   )   (princ))(vl-load-com) (princ)
 
I wouldn't assume that the current profile will always be first in the list returned by the getallprofilenames method.

Tharwat 发表于 2022-7-6 06:56:22

Lee , May I know what's the new with your code to mine ?

BlackBox 发表于 2022-7-6 06:58:57

 
If I may... Consider the difference between (car nm), and (getvar 'cprofile), in the context of Lee's ending comment.

Tharwat 发表于 2022-7-6 07:02:42

 
However if the Auto-Cad session has only one profile or more the (car nm) would return a name of a profile and would copy one
of them and activate it as it's been asked by the OP .

Lee Mac 发表于 2022-7-6 07:06:47

 
But the OP states:
 
Hence my comment:

helmer 发表于 2022-7-6 07:10:24

 
Checked in the profiles tab but there is only Unnamed profile that is listed. I have also tried it after adding other profiles but nothing seams to happen.
页: [1] 2
查看完整版本: Check if a profile exist, copy