Saturday, March 31, 2012

VLDB Code Example: Reload Profile From .ARG

Another set of code from Chapter 19, of my book "The Visual LISP Developer's Bible (2011 Edition)" available on Amazon for Kindle and Kindle Reader apps.  This one reloads an existing AutoCAD Profile from a source .ARG file.  As you may know, if you load an .ARG file, it is imported into the Registry.  Each time you launch AutoCAD, if the shortcut or command line specifies /P to specify a Profile (even a full path to an .ARG file) if a Profile already exists (by the same name) in the Registry, the .ARG file is ignored and the Profile is loaded from the Registry.  This is pretty much the same way a web browser cache works when loading stored images.  If you want it to force a reload from the source .ARG file, here's one way to do it...

;;; 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: