Topic: Renaming XRefs

[cmwade77]

Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.

[Lee Mac]

Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.

You're welcome Chris 

[JohnK]

Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.

Okay, im confused now; so you're not open to suggestions then.

[cmwade77]

Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.

Okay, im confused now; so you're not open to suggestions then.

I am; however, I was simply explaining why that method would not work correctly for my needs, unless there is something that I do now know about getfiled, last that I checked, it required the user to select a file, you cannot simply select a folder with it.

[JohnK]

correct.

Im saying that you are (well, your program is) assuming too much and should be a little more foolproof IMO.  If i were writing this, i would search for the  'remap.dat' and search thru some directories (up a few levels from the current maybe) for the "correct" one (and if you cant determine the "correct" one based upon specific rules, or there are several choices, whatever) you can then ask for a drawing. Basically, I would make my program do some basic research before I started modifying a production drawing.

[cmwade77]

That I do agree with; however, I have other tools in place to take care of those issues, such as it actually checks the project number to ensure things are correct, but I never put that part of my code on these boards, as I want to keep it generic so that anyone could use or modify it. In addition, there is only myself and two other people that do drawing setup, so making sure they know what they are doing is fairly easy.

[JohnK]

I dont trust anything or anyone in my routines. I do my homework before i do ANYTHING to a drawing.  And, just to give you a frame of reference, I just did 119 (thats with comments) lines of code to do what i think you should do.

HTH

[cmwade77]

Ok, I am working on putting more error handling and logging into my routine, for some reason when I run the following code, I get Automation Error. Key not found

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)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(setq fld (strcat (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0) "\\"))
(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)) "\\")
)
(cond
((= (vl-file-size (strcat fld a)) nil)

(princ (strcat "\nModifying 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))
(princ (strcat "\n\tOld block name - " x " - 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\tOld xref name - " x " - 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)
 (setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
 )
 (setq nbname (blockcheck newname))
 (princ (strcat "\n\tOld block name - " x " - 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\tOld xref name - " x " - 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)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(setq nbname (blockcheck newname))
(princ (strcat "\n\tOld block name - " x " - 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\tOld xref name - " x " - 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)
)



;;; Code below comes from: http://www.jtbworld.com/lisp/axblock.htm
;;; Test if block named "revtext2" exist
;;; (ax:ExistBlock doc "revtext2")
(defun ax:ExistBlock (doc bn / layout i exist)
  (setq exist nil)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (setq exist T)
      )
    )
  )
  exist
)

;;; Rename block from "revtext" to "revtext1"
;;; (ax:RenameBlock doc "revtext" "revtext1")
(defun ax:RenameBlock (doc bn nn / layout i)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (vla-put-name i nn)
      )
    )
  )
)    

(defun BlockCheck (name / Doc space x i data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((= (ax:ExistBlock Doc name) T)
(setq i 1)
)
)
(while (= (ax:ExistBlock Doc (strcat name (rtos i 2 0))) T)
(setq i (+ i 1))
)
(ax:RenameBlock Doc name (strcat name (rtos i 2 0)))
    (setq data (strcat name (rtos i 2 0)))
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 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
)I get this error when there is a block name that is the same as the new file name for one of the xrefs......any ideas?

[Lee Mac]

I get this error when there is a block name that is the same as the new file name for one of the xrefs......any ideas?

I haven't looked properly at your code, but the case you mention should be tested for - as I do in my original routine.

[cmwade77]

Lee, unless I missed something in your original routine (which is quite possible), it test for it, but doesn't allow the xref to be renamed if the block exists, what I am trying to accomplish is:

• Check if there is a block name with the new xref name
• Rename the block name to something unique
• Then continue redoing the xref

Please let me know if I misunderstood how your code handled this.

[ronjonp]

Why don't you take the route suggested here?

http://www.theswamp.org/index.php?topic=35702.msg409391#msg409391

Seems like a MUCH easier solution  

This might be messing up your routine above:

Code: [Select]

; === Top statistic:
; Global variables: (FLOG NBNAME)

[cmwade77]

It would be a much easier solution; however, it is not what many of our clients want and I almost have this method completed. In the long run this will be the better solution for us, just a pain in the neck getting it going properly in the first place.

[Lee Mac]

My code tested for the case, but you are correct, it did not offer an alternative.

Finding a unique name is pretty easy though, something like this perhaps:

Code: [Select]

(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
  )
)
       


Code: [Select]

(UniqueKey <BlocksCollection> <XRefName>)
Hacked together, sorry 

[cmwade77]

Lee, your hacked together code usually works better than my debugged code....LOL

Ok, 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)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq fld (strcat (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0) "\\"))
(cond
((and (/= fld "") (/= fld nil) (/= 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)) "\\")
)
(cond
((= (vl-file-size (strcat fld a)) nil)

(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)
  (setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
  )
  (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)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(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 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)))))
)
  )
  (cond
  ((= PATH nil)
  (setq path "")
  )
  )
  Path
)
The last thing that doesn't work correctly for me is when it prompts for a filename, I want it to loop until one is provided, right now if the user hits Cancel, the command errors out.

[Lee Mac]

Chris,

You shouldn't need to modify the directory dialog routine whatsoever.

Just test for a selected directory:

Code: [Select]

(if (setq Directory (LM:DirectoryDialog ... ))
...
Be sure to know the returns of my function - all the information is listed on my site - you cannot 'strcat' a nil value.