AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Visual Lisp and Profiles

Profiles are a great way of quickly loading your standard settings and ensuring that drawing office standards are adhered too.
To get to the Profiles in Visual Lisp, we need to reference the PreferencesProfiles Object. Here's an extract from the AutoCAD Object Model :


Application (Object)
     |
     |
     |----- Preferences
     |       (Object)
     |           |
     |           |
     |           |
     |           |----- PreferencesProfiles
     |           |          (Object)
     |           |
     |           |
     |           |

Firstly, we need a reference to the Application Object :

_$ (vl-load-com)

_$ (setq acadobject (vlax-get-Acad-Object))
#<VLA-OBJECT IAcadApplication 00adc088>

And next the Preferences Object :

_$ (setq acadprefs (vla-get-preferences acadobject))
#<VLA-OBJECT IAcadPreferences 02d003cc>

And now a reference to the PreferencesProfiles Object :

$ (setq acadprofiles (vla-get-profiles acadprefs))
#<VLA-OBJECT IAcadPreferencesProfiles 02d003bc>

Let's run a dump on the PreferencesProfile Object :

_$ (vlax-dump-object acadprofiles T)
; IAcadPreferencesProfiles: This object contains the options from the Profiles tab on the Options dialog

; Property values:
; ActiveProfile = "<<Unnamed Profile>>"
; Application (RO) = #<VLA-OBJECT IAcadApplication 00adc088>

; Methods supported:
; CopyProfile (2)
; DeleteProfile (1)
; ExportProfile (2)
; GetAllProfileNames (1)
; ImportProfile (3)
; RenameProfile (2)
; ResetProfile (1)
T

As you can see, this Object has only one Property that really interests us, the Active Profile, but seven Methods that look quite interesting
Let's have a look at the Active Profile Property first :

_$ (setq actprofile (vla-get-ActiveProfile acadprofiles))
"Admin"

This tells us quite clearly that the Active Profile on my system is a profile named "Admin".
But, we would like to have a list of all profile names. For this we would need to use the GetAllProfilesNames Method :

(vlax-invoke-method acadProfiles 'GetAllProfileNames 'thelist)
nil

Let's have a look at "thelist" "

_$ thelist
#<safearray...>

Oh, oh, it's a safearray. We need to convert it :

_$ (vlax-safearray->list thelist)
("Admin" "Eric")

That's better, now we've got a list of all presently loaded profiles.
Let's load a new one :

_$ (setq NewProfile (vlax-invoke-method acadprofiles 'ImportProfile "NDBE51D1" "c:/Profiles/NDBE51D1.arg" :vlax-true))
nil

Have a look at your "Profiles" under "Options". A new profile should have been Imported.
Let's check that it's there programmically :

_$ (vlax-invoke-method acadProfiles 'GetAllProfileNames 'thelist)
nil
_$ (vlax-safearray->list thelist)
("Admin" "Eric" "NDBE51D1")

OK, I'm happy now, I know it's there.
We still though, need to make it the Active Profile :

_$ (vla-put-ActiveProfile acadProfiles "NDBE51D1")
nil

Let's Export a profile :

_$ (vlax-invoke-method acadProfiles 'ExportProfile "Eric" "c:/profiles/eric.arg")
nil

Have a look in your Profiles directory. You should have a new arg file.
Right, now let's be nasty and delete a profile :

_$ (vlax-invoke-method acadProfiles 'DeleteProfile "NDBE51D1")
; error: Automation Error. Cannot delete a profile that is in use.

Ha, ha, of course we can't delete that profile 'cos it's the Active Profile.
OK, let's try another one :

_$ (vlax-invoke-method acadProfiles 'DeleteProfile "Admin")
nil

Bye, bye, Mr Admin profile.
Let's reset a profile :

_$ (vlax-invoke-method acadProfiles 'ResetProfile "Eric")
nil

Hey, nothing happened! That's because the profile "Eric" is not the Active Profile.
Let's try again :

_$ (vlax-invoke-method acadProfiles 'ResetProfile "NDBE51D1")
nil

That's better, the profile is reloaded.
Let's copy an existing profile to a new profile :

_$ (vlax-invoke-method acadProfiles 'CopyProfile "NDBE51D1" "CopiedProfile")
nil

We now have a new profile named "CopiedProfile". Let's rename it :

_$ (vlax-invoke-method acadProfiles 'RenameProfile "CopiedProfile" "RenamedProfile")
nil

Let's list them again :

_$ (vlax-invoke-method acadProfiles 'GetAllProfileNames 'thelist)
nil
_$ (vlax-safearray->list thelist)
("Eric" "NDBE51D1" "RenamedProfile")


Here's a little application that you may find interesting. It will check the Login Name of the user and automatically load the relevant Profile for that user.

Firstly you need to name your Profiles the same as your Login Name. e.g. if your Login Name is NDBE51D1, your Profile must be named NDBE51D1.ARG. Then you need to store all your user Profiles in the same folder. (This example uses "c:/profiles/").

Irrespective of which user logs in, the specific Profile for that user will be loaded if necessary, and made Active.

Not much in the way of error checking at the moment I'm afraid.....

;CODING STARTS HERE
(prompt "\nType LoginProfile to run......")

(vl-load-com)

(defun C:LoginProfile (/ profilename acadprofiles actprofile
                                     thelist profilepath)

;retrieve the users login name
(setq profilename (strcase (getvar "LOGINNAME")))

;retrieve a reference to the Profiles
(setq acadprofiles (vla-get-profiles
(vla-get-preferences (vlax-get-Acad-Object))))

;retrieve the Active Profile
(setq actprofile (strcase (vla-get-ActiveProfile acadprofiles)))

;if they are not the same
(if (/= profilename actprofile)

    ;do the following
    (progn

                ;get a list of the loaded profiles
                (vlax-invoke-method acadProfiles 'GetAllProfileNames 'thelist)

                 ;convert to a list
                (setq thelist (vlax-safearray->list thelist))

;if the profile is not in the list
(if (not (member profilename thelist))

;do the following
(progn

     ;store the profile file
     (setq profilepath
        (strcat "c:/profiles/" profilename ".arg"))

;if the profile is found
(if (findfile profilepath)

    ;do the following
    (progn

                 ;load the profile
                 (setq NewProfile (vlax-invoke-method
                 acadprofiles 'ImportProfile
                 profilename profilepath :vlax-true))

   ;make the profile the Active Profile
   (vla-put-ActiveProfile acadProfiles profilename)

    );progn

    ;profile file cannot be found - exit
    (prompt (strcat "\nCannot find profile " profilepath))

);if

 );progn

;it is loaded but make the profile the Active Profile
(vla-put-ActiveProfile acadProfiles profilename)

);if


    );progn
           
                ;We could reload the Profile if we wish.
                ;Just uncomment the next line.
                ;(vlax-invoke-method acadProfiles 'ResetProfile profilename)

);if

    (princ)

);defun

(princ)
;CODING ENDS HERE

And here's a few miscellaneous Profile Functions :

;;; profiles.lsp
;;; miscellaneous profile commands
;;; by Jimmy B
;;;  2000-01-25
;;;----------------

(defun getActiveProfile ()
  (vla-get-activeprofile
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
  )
)

(defun putActiveProfile (profilename)
  (vla-put-activeprofile
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
    profilename
  )
)

(defun getAllProfileNames(/ allprofiles)
  (vla-getallprofilenames
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object))) 
    'allprofiles
  )
  (vlax-safearray->list allprofiles)
)

(defun existProfile (profilename)
  (not (not (member
    (strcase profilename)
    (mapcar '(lambda (x) (strcase x)) (getallprofilenames))
  )))
)

(defun c:listProfileNames(/ nr profnames)
  (setq nr 0)
  (setq profnames (getAllProfileNames))
  (repeat (length profnames)
    (princ (nth nr profnames))
    (print)
    (setq nr (1+ nr))
  )
  (princ)
)

; return T if profile is deleted and nil if not
(defun deleteProfile (profilename)
  (if (and
        (/= (strcase profilename) (strcase (getActiveProfile)))
        (existProfile profilename))
    (not (vla-deleteprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
    ))
  )
)

; return T if profile is reseted and nil if not
(defun resetProfile (profilename)
  (if (existProfile profilename)
    (not (vla-resetprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
    ))
  )
)

; return T if profile is renamed and nil if not
; if profilenameNew exist it's substituded with profilenameOld
(defun renameProfile (profilenameOld profilenameNew)
  (if (existProfile profilenameOld)
    (not (vla-renameprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilenameOld
      profilenameNew
    ))
  )
)

; return T if profile is copied and nil if not
; if profilename2 exists it's copied
(defun copyProfile (profilename1 profilename2)
  (if (existProfile profilename1)
    (not (vla-copyprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename1
      profilename2
    ))
  )
)

; (exportProfile "profilename" "C:\\TEMP\\profilename.arg")
; if path is omitted profile is saved in active directory
; overwrites argname if it exists
; return T if profile is exported
(defun exportProfile (profilename argname)
  (if (existProfile profilename)
    (not (vla-exportprofile
      (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
      profilename
      argname
    ))
  )
)

; (importProfile "profilename" "C:\\TEMP\\profilename.arg" 1)
; overwrites profilename if it exists
; if path is omitted profile is imported from active directory
; inclpathinfo=1   The path information in the registry file
; will be preserved.
; inclpathinfo=0   The path information in the registry file
;will not be preserved.
; return T if profile is imported
(defun importProfile (profilename argname inclpathinfo)
  (not (vla-importprofile
    (vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
    profilename
    argname
    inclpathinfo
  ))
)
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website