Topic: Renaming XRefs

[cmwade77]

Ok, I see where the problem was now, thank you.....I still want to know about the select files portion though, why it errors out when pressing cancel....doesn't make sense to me on that one.

[JohnK]

Didnt you already dismiss the idea from me about re-arranging your routine saying that you had some other standard checks and stuff? I dont think you understood any of my intentions.

[Lee Mac]

You mean the getfiled section? Because (vl-filename-base nil) will error.

You need to know what files can accept a nil argument, and which will need more error trapping. IMO quite a lot of the code needs rewriting, you assume too much without sufficient error trapping.

[cmwade77]

Didnt you already dismiss the idea from me about re-arranging your routine saying that you had some other standard checks and stuff? I dont think you understood any of my intentions.

I was referring to the checking for folders with standards....I did realize that checking blocks was needed, as well as logs of what changes took place.

[cmwade77]

You mean the getfiled section? Because (vl-filename-base nil) will error.

You need to know what files can accept a nil argument, and which will need more error trapping. IMO quite a lot of the code needs rewriting, you assume too much without sufficient error trapping.

You are probably correct on that, I know it is no where near as neat and tidy as it should be, I just haven't had the time to do so.

[Lee Mac]

You are probably correct on that, I know it is no where near as neat and tidy as it should be, I just haven't had the time to do so.

I might be alone on this, but when I write a routine, I don't write a fully operational program and subsequently attempt to tidy it up with regards to error trapping - that's way too much work, and you are effectively doing the job twice over.

The way I approach the task is to evaluate, at every stage, what assumptions I am making, and to account for them. Hence, at every prompt or position at which the program doesn't hold all the cards, think about every eventuality and provide an error-free backdoor for it. For example, if there is just the slightest possibility that an argument for a function might be nil, account for this case, and check for a valid value before proceeding.

Honestly, overall, it doesn't take much more time - if anything, you spend less time searching for bugs and you have a more robust program to show for it.

My 2 cents,

Lee

[cmwade77]

Code: [Select]

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

[cmwade77]

Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded.

[ronjonp]

Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded.

Wouldn't you want to rename regardless if it's loaded or not (or does it chuck a wobbly?).

[cmwade77]

Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded and maintain that status.

Wouldn't you want to rename regardless if it's loaded or not (or does it chuck a wobbly?).

Yes, but I don't want them reloaded, but I was able to find another thread that helped me get the routine working, here is what I have:

Code: [Select]

;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 LoadTst)
(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)) "\\")
  LoadTst (Isloaded Doc a)
)
(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)
)
)
(bei:xrwork fld newname pth flog x LoadTst)
(setq changed T)
)
)
)
    )
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
(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)
)
  )
  (bei:xrwork fld newname pth flog x LoadTst)
)
(T
(princ (strcat "\n\t" (getcdate) " - File " pth oldname " was not modified, because the user pressed cancel.") flog)
)
)
)
)
)
(T
(setq oldname a)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
(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)
)
)
(bei:xrwork fld newname pth flog x LoadTst)
)
(T
(princ (strcat "\n\t" (getcdate) " - File " pth oldname " was not modified, because the user pressed cancel.") flog)
)
)

)
)
)
)
)
)
(setq newname nil
  oldname nil
      changed nil)
)
(close flog)
)
)
(princ)
)

(defun bei:xrwork (fld newname pth flog x LoadTst /)
(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"))
(cond
((= LoadTst T)
(vla-reload x)
)
(T
(vla-unload x)
)
)
)

; Code Modifed from T. Willey's code at: http://www.theswamp.org/index.php?topic=4103.msg103206#msg103206
(defun IsLoaded (Doc BL / tmpObj Layout i)
(vlax-for Layout (vla-get-Layouts Doc)
(vlax-for i (vla-get-Block Layout)
(cond
((= (strcase (vla-get-name i)) (strcase BL))
(if
(and
(= (vla-get-ObjectName i) "AcDbBlockReference")
(vlax-property-available-p i 'Path)
(setq tmpObj (vla-Item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) (vla-get-Name i)))
(assoc 71 (entget (tblobjname "block" (vla-get-Name i))))
)
(setq LD nil)
(setq LD T)
)
)
)
)
)
LD
)


;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
)Thank you all for your help with this.