;;; Reloads a profile from an ARG file ;;; 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))) )The Visual LISP Developers Bible – 2011 Edition
http://sites.google.com/site/visuallispbible
Copyright ©2002-2010 David M. Stein, All Rights Reserved.
No comments:
Post a Comment