Batch Rename Files Using Attributes from Title Block

[schleede.dave]

A vendor has recently turned over a few thousand drawings that all have issues with naming.  I've been trying to batch rename them using a modified version of the lisp routine found here:

  Batch Rename Using Attribute from Title Block - Autodesk Community - AutoCAD

My modified version works sometimes but other times it fails.  It seems to get "hung up" on certain files; if I remove these files from the folder the routine will often run correctly.  In some cases the reason for this is obvious (the drawing doesn't contain the required block or has an issue that prevents it from opening correctly).  Other times there doesn't seem to be any obvious reason for it to fail.  My LISP/VBA skills are not up to the task of finding and fixing the issue.  I'm wondering if anyone here might be able to help.

The modified code is:

(defun c:BatchRename (/ *error* Directory-Dia BlkName1 BlkName2 TagName1 TagName2 TagName3 TagName4 Dir dbxApp FileName RenameList)
(vl-load-com)
(defun *error* (msg)
(if dbxApp (vlax-release-object dbxApp))
(setq dbxApp nil)
(vl-bt)
)
(defun Directory-Dia ( Message / sh folder folderobject result)
(vl-load-com)
(setq sh (vla-getInterfaceObject(vlax-get-acad-object)"Shell.Application"))
(setq folder
(vlax-invoke-method
sh
'BrowseForFolder
(vla-get-HWND (vlax-get-Acad-Object))
Message
0
)
)
(vlax-release-object sh)
(if folder
(progn
(setq folderobject (vlax-get-property folder 'Self))
(setq result(vlax-get-property FolderObject 'Path))
(vlax-release-object folder)
(vlax-release-object FolderObject)
(if (/= (substr result (strlen result)) "\\")
(setq result (strcat result "\\"))
result
)
)
)
)
;--------------------------------------------------------------------------------------
(setq BlkName "VENDORS"
TagName1 "AREA"
TagName2 "TYPE"
TagName3 "DWG"
TagName4 "REV"
)
(if (setq Dir (Directory-Dia "Select directory to rename."))
(progn
(setq dbxApp
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
)
)
(foreach file (mapcar (function (lambda (x) (strcat Dir x))) (vl-directory-files Dir "*.dwg" 1))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbxApp file)))
(prompt (strcat "\n *Error opening file: " file))
(vlax-for lo (vla-get-Layouts dbxApp)
(vlax-for obj (vla-get-Block lo)
(if
(and
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-Name obj) BlkName)
)
(foreach att (vlax-invoke obj 'GetAttributes)
(PROGN
(if (= (vla-get-TagString att) TagName1)(setq FileName (vla-get-TextString att)))
(if (= (vla-get-TagString att) TagName2)(setq FileName (strcat Filename "-" (vla-get-TextString att))))
(if (= (vla-get-TagString att) TagName3)(setq FileName (strcat Filename "-" (vla-get-TextString att))))
(if (= (vla-get-TagString att) TagName4)(setq FileName (strcat Filename " REV " (vla-get-TextString att))))
)
)
)
)
)
)
(setq RenameList (cons (cons file FileName) RenameList))
(setq FileName nil)
)
)
)
(vlax-release-object dbxApp)
(setq dbxApp nil)
(foreach i RenameList
(if
(or
(null (cdr i))
(not (vl-file-rename (car i) (strcat Dir (cdr i) ".dwg")))
)
(prompt "\n *Was not able to rename: " (car i))
)
)
;(princ)
)

If I press "F2" after running it I see:

Backtrace:
[0.53] (VL-BT)
[1.49] (*ERROR* "too many arguments") LAP+43
[2.43] (_call-err-hook #<USUBR @00000219d3aac598 *ERROR*> "too many arguments")
[3.37] (sys-error "too many arguments")
:ERROR-BREAK.32 "too many arguments"
[4.29] (PROMPT "\n *Was not able to rename: " "C:\\Users\\dschleed\\OneDrive - The Mosaic Company\\Desktop\\New folder (2)\\Drawing1.dwg")
:XTSF-MARK.23 (FOREACH nil #<SUBR @00000219d6c1bfc0 nil> (Rest-List I))
[5.20] (C:BATCHRENAME) LAP+1291
[6.15] (#<SUBR @00000219d6c1a228 -rts_top->)
[7.12] (#<SUBR @00000219d3a68700 veval-str-body> "(C:BATCHRENAME)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)

Thanks in advance for any and all help.

[ebsoares]

Try @pbejse's solution (9/25) here:

LISP to change a specific attribute from a specific block to a specific value 

Cheers,

Edgar

[schleede.dave]

I need to change the filename to match an attribute value (4 attributes actually).  I'm not looking to change the value of the attributes themselves.

[maratovich]

Maybe this will help you - AutoReplaceCAD 

[schleede.dave]

Thanks for the suggestion.  I'd rather solve this using LISP or VBA as I don't need to go through IT to use them.

[schleede.dave]

Anyone?

[Sea-Haven]

Have you thought about using say OBDX and writing a BAT file that has rename file may be a simple way around can check BAT file before running.

Rename oldfile newfile

[ebsoares]

Adding to what @Sea-Haven mentioned, another option would be a two-step process. One would be running a routine that reads all the dwg files in your list for all the attributes that you need, and then having that routine create a "report" file/list (something like a csv file). Then use another routine (likely ODBX, like he mentioned, or another renaming utility altogether, like "Advanced Renamer") to actually, finally rename your dwg files.