;;; Reloads a profile from an ARG fileThe Visual LISP Developers Bible – 2011 Edition
;;; Replaces existing profile if defined
;;; Returns profile name if successful, otherwise returns nil
(defun Profile-Reload (name ARGname / bogus)
(cond
( (and
(Profile-Exists-p name)
(findfile ARGname)
)
(if (/= (strcase name) (strcase (vla-get-ActiveProfile (AcadProfiles))))
(Profile-Delete name)
(progn
(setq bogus "bogus")
(Profile-Rename name bogus)
)
)
(Profile-Import name ARGname)
(vla-put-ActiveProfile (AcadProfiles) name)
(if bogus (Profile-Delete bogus))
name
)
( (and
(not (Profile-Exists-p name))
(findfile ARGname)
)
(Profile-Import name ARGname)
(vla-put-ActiveProfile (AcadProfiles) name)
name
)
( (not (findfile ARGname))
(princ (strcat "\nCannot locate ARG source: " ARGname)) nil
)
)
)
;;; Renames an existing profile
;;; Returns new profile name if successful, otherwise returns nil
(defun Profile-Rename (from to / result)
(if (Profile-Exists-p from)
(if (not (Profile-Exists-p to))
(cond
( (not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply
'vla-RenameProfile
(list (AcadProfiles) from to)
)
)
)
) to ; Return new name if successful!
)
)
)
)
;;; Deletes an existing profile
;;; Returns T if successful, otherwise returns nil
(defun Profile-Delete (strName / result)
(if (Profile-Exists-p strName)
(cond
( (not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply
'vla-DeleteProfile
(list (AcadProfiles) strName)
)
)
)
)
T ; return T for success!
)
)
)
)
;;; Imports a profile from a given ARG file
;;; Returns profile name if successful, otherwise returns nil
(defun Profile-Import (argFile strName / result)
(cond
( (findfile argFile)
(cond
( (not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply
'vla-ImportProfile
(list (AcadProfiles) strName argFile vlax-True)
)
)
)
)
strName ; return new profile name if successful!
)
)
)
)
)
;;; Determine if profile name is already defined (exists)
;;; Returns T or nil
(defun Profile-Exists-p (name)
(get-item (AcadProfiles) name)
)
;;; Return Profiles collection object
(defun AcadProfiles ()
(vla-get-profiles (vla-get-preferences (vlax-get-acad-object)))
)
http://sites.google.com/site/visuallispbible
Copyright ©2002-2010 David M. Stein, All Rights Reserved.
0 comments:
Post a Comment