;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed Doc space flog nbname dwgpth)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(if (setq fld (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0)) (setq fld (strcat fld "\\")))
(cond
((and (/= fld "") (/= fld nil) (/= fld "\\"))
(setq fld (bei:path fld))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
)
(setq pth (bei:path pth)
dwgpth (bei:path (getvar "dwgprefix"))
)
(cond
((and (= (vl-file-size (strcat fld a)) nil) (/= (strcase pth) (strcase dwgpth)))
(princ (strcat "\n" (getcdate) " - Modifying drawing " (getvar "dwgprefix") (getvar "dwgname") ":") flog)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(while (= newname nil)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
(T
(setq oldname a)
(while (= newname nil)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
(close flog)
)
)
(princ)
)
;UniqueKey Code from LeeMac at http://www.theswamp.org/index.php?topic=35702.msg409606#msg409606
(defun UniqueKey ( collection seed / _isItem )
(defun _isItem ( collection key )
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list collection key))
)
)
)
(
(lambda ( i / n )
(if (_isItem collection seed)
(while
(_isItem collection
(setq n
(strcat seed (itoa (setq i (1+ i))))
)
)
)
(setq n seed)
)
n
)
0
)
)
(DEFUN bei:path (pth /)
(cond
((/= (substr pth (strlen pth) 1) "\\")
(setq pth (strcat pth "\\"))
)
)
pth
)
(defun BlockCheck (name2 / data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((/= (tblsearch "BLOCK" name2) nil)
(setq data (UniqueKey (vla-get-blocks Doc) name2))
(vl-cmdf "._rename" "block" name2 data)
)
(T
(setq data name2)
)
)
data
)
;; Folder selection routine comes from: http://lee-mac.com/directorydialog.html
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun GETCDATE (/ CDATE)
(setq CDATE (rtos (getvar "CDATE") 2 6)
CDATE (strcat
(substr CDATE 5 2)
"/"
(substr CDATE 7 2)
"/"
(substr CDATE 1 4)
" @ "
(substr CDATE 10 2)
":"
(substr CDATE 12 2)
)
)
cdate
)
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
Alright, I have corrected those items, but I know I am missing something that would be useful for error handling here, I just can't put m,y finger on it......I know he remap.dat file will always be correct when available, so I don't have to worry about that.
Lee,
I think you are correct on that as well, just sometimes I don't catch my mistakes until I am done.....but, as I have said before, I am constantly learning with LISP.
EDIT: I think I have caught all of the assumptions and error checked them properly now, I have updated the code above. Please let me know if I missed something.