为多个目录中的多个文件更改绘图仪
**** Hidden Message ***** 给你。这将处理目录及其子目录。您需要在代码顶部指定旧的和新绘图仪。
将创建一个日志文件，以便您可以检查实际更改了哪些文件。
请先对一些虚拟数据运行此命令。
(defun c:changepc3
(/ _openfile _subfolders _getdirectory dir doc folders l logfile new odbx old save v)
(vl-load-com)
;; Change this value - ie. { "old.pc3" or "\\\\servername\\oldsharedprintername" }
(setq old "old.pc3")
;; Change this value - ie. { "new.pc3" or "\\\\servername\\newsharedprintername" }
(setq new "new.pc3")
(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 (
(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)
) 这对你有用吗？
页:
[1]