Code Red > AutoLISP (Vanilla / Visual)
Batch change plot style table lisp not working
(1/1)
tive29:
http://www.theswamp.org/index.php?topic=42694.msg478856#msg478856
I got the lisp code from the above link by ronjonp but it is not working for me.
I need to change a batch of drawings from ""NONE to "MyplotStyle.ctb"
This is the edited lisp
Why is it not working?
--- Code: --- (defun c:changepc3
(/ _openfile _subfolders _getdirectory dir doc folders l logfile new odbx old save v)
(vl-load-com)
;; Change this value - ie. { "*" or "\\\\servername\\oldsharedprintername" }
(setq old "*)
;; Change this value - ie. { "MyplotStyle.ctb" or "\\\\servername\\newsharedprintername" }
(setq new "MyplotStyle.ctb")
(defun _openfile (file / sh)
(if (findfile file)
(progn (setq sh (vlax-get-or-create-object "Shell.Application"))
(vlax-invoke-method sh 'open (findfile file))
(vlax-release-object sh)
file
)
)
)
(defun _getdirectory (message / sh folder result)
(setq sh (vlax-get-or-create-object "Shell.Application"))
(setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
(vlax-release-object sh)
(if folder
(progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
(if (/= (substr result (strlen result)) "\\")
(setq result (strcat result "\\"))
result
)
)
)
)
(defun _subfolders (path / folder fs lst subs)
(setq fs (vlax-get-or-create-object "Scripting.FileSystemObject"))
(if
(and (setq folder (vlax-invoke fs 'getfolder path)) (setq subs (vlax-get folder 'subfolders)))
(mapcar (function (lambda (x) (cons x (apply 'append (_subfolders x)))))
(vlax-for sub subs (setq lst (cons (strcat (vlax-get sub 'path) "\\") lst)))
)
)
)
(setq doc (vlax-get-acad-object))
(cond
((not (setq odbx (if (< (setq v (substr (getvar 'acadver) 1 2)) "16")
(vla-getinterfaceobject doc "ObjectDBX.AxDbDocument")
(vla-getinterfaceobject doc (strcat "ObjectDBX.AxDbDocument." v))
)
)
)
(princ "\nObject DBX interface not created!")
)
((if (and (setq dir (_getdirectory "Choose a folder to process (subfolders processed too)..."))
(and (setq folders (apply 'append (_subfolders dir)))
(setq folders (append (list dir) folders))
)
(setq logfile (open (setq l (strcat dir "logfile.csv")) "w"))
)
(progn
(write-line "FILE,TABS UPDATED,SAVED" logfile)
(foreach folder folders
(foreach file (vl-directory-files folder "*.dwg" 0)
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-open (list odbx (strcat folder file)))
)
(write-line (strcase (strcat "!!Error opening: " (strcat folder file))) logfile)
(progn
(setq save 0)
(vlax-for x (vla-get-layouts odbx)
(if (wcmatch (strcase (vla-get-configname x)) (strcase old))
(progn (and (not (vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-configname (list x new))
)
)
(setq save (1+ save))
)
)
)
)
(if (zerop save)
(write-line (strcat (strcat folder file "," (itoa save) ",NO")) logfile)
(progn (write-line (strcat (strcat folder file "," (itoa save) ",YES")) logfile)
(vla-saveas odbx (vla-get-name odbx))
)
)
)
)
)
)
(close logfile)
(_openfile l)
)
)
)
)
(princ)
)
--- End code ---
roy_043:
This stands out:
--- Code: ---(setq old "*)
--- End code ---
Should be :
--- Code: ---(setq old "*")
--- End code ---
Navigation
[0] Message Index
Go to full version