Based on http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31023zx and http://www.autocad.ru/cgi-bin/f1/board.cgi?t=28195cT :
Code:
;|
Based on CADALYST 03/05 Tip2023: PurgeFiles.lsp Directory Clean Up (c) Andrzej Gumula
[c]2004 Andrzej Gumula, Katowice, Poland
e-mail: a.gumula@wp.pl
|;
(vl-load-com)
(defun dofile (curdoc)
(vla-put-activelayer curdoc (vla-item (vla-get-layers curdoc) "0"))
(vl-catch-all-apply '(lambda () (vla-zoomall (vlax-get-acad-object))))
(repeat 4 (vla-purgeall curdoc))
) ;_ end of defun
(defun c:dofile (/ fileslist subdir files file)
(defun getfolder (/ dir item path)
(cond
((setq dir
(vlax-invoke
(vlax-get-or-create-object "Shell.Application")
'browseforfolder
0
"Select folder with DWG files:"
1
""
) ;_ end of vlax-invoke
) ;_ end of setq
(cond
((not (vl-catch-all-error-p
(vl-catch-all-apply 'vlax-invoke-method (list dir 'items))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(setq item (vlax-invoke-method
(vlax-invoke-method dir 'items)
'item
) ;_ end of vlax-invoke-method
) ;_ end of setq
(setq path (vla-get-path item))
(if
(not (member (substr path (strlen path) 1) (list "/" "\\")))
(setq path (strcat path "\\"))
) ;_ end of if
)
) ;_ end of cond
)
) ;_ end of cond
path
) ;_ end of defun
(defun vl-findfile (location / dirlist path allpath)
(makedirlist location)
(setq dirlist (cons location dirlist))
(foreach elem dirlist
(if (setq path (vl-directory-files elem "*.dwg"))
(foreach item path
(setq allpath (cons (strcat elem "/" item) allpath))
) ;_ end of foreach
) ;_ end of if
) ;_ end of foreach
(reverse allpath)
) ;_ end of defun
(defun makedirlist (arg / tmplist)
(setq tmplist (cddr (vl-directory-files arg nil -1)))
(cond (tmplist
(setq dirlist (append
dirlist
(mapcar '(lambda (z) (strcat arg "/" z)) tmplist)
) ;_ end of append
) ;_ end of setq
(foreach item tmplist (makedirlist (strcat arg "/" item)))
)
) ;_ end of cond
) ;_ end of defun
(setq *err-list* nil)
(if (not filesystemobject)
(setq filesystemobject
(vla-getinterfaceobject
(vlax-get-acad-object)
"Scripting.FileSystemObject"
) ;_ end of vla-getInterfaceObject
) ;_ end of setq
) ;_ end of if
(cond
((= (getvar "SDI") 0)
(cond
((setq dwgpath (getfolder))
(initget 1 "Yes No")
(setq
subdir (cond
((getkword "\nInclude subdirectories? [Yes/No]: "))
(t "Yes")
) ;_ end of cond
) ;_ end of setq
(if (equal subdir "Yes")
(setq files
(vl-findfile (substr dwgpath 1 (1- (strlen dwgpath))))
) ;_ end of setq
(setq files (mapcar '(lambda (x) (strcat dwgpath x))
(vl-directory-files dwgpath "*.dwg" 1)
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of if
(setq files (mapcar 'strcase files))
(cond
(files
(vlax-for & (vla-get-documents (vlax-get-acad-object))
(setq fileslist
(cons (strcase (vla-get-fullname &)) fileslist)
) ;_ end of setq
) ;_ end of vlax-for
(foreach & files
(cond
((not (member & fileslist))
(cond
((/= (logand (vlax-get-property
(vlax-invoke-method
filesystemobject
'getfile
&
) ;_ end of vlax-invoke-method
'attributes
) ;_ end of vlax-get-property
1
) ;_ end of logand
1
) ;_ end of /=
(cond
((setq file
(vla-open (vla-get-documents
(vlax-get-acad-object)
) ;_ end of vla-get-documents
&
) ;_ end of vla-open
) ;_ end of setq
(prompt
(strcat "\nProcessing file" & ". Please wait...")
) ;_ end of prompt
(dofile file)
(prompt (strcat "\nSave and close " &))
(vla-save file)
(vla-close file)
(vlax-release-object file)
)
(t
(prompt
(strcat
"\nCannot open "
&
"\nDrawing file was created by an incompatible version. "
) ;_ end of strcat
) ;_ end of prompt
)
) ;_ end of cond
)
(t (prompt (strcat & " is read-only. Purge canceled. ")))
) ;_ end of cond
)
(t (prompt (strcat & " is open now. Purge canceled. ")))
) ;_ end of cond
) ;_ end of foreach
)
(t (prompt "\nNothing files found to purge. "))
) ;_ end of cond
)
(t (prompt "\nNothing selected. "))
) ;_ end of cond
)
(t (prompt "\nThe routine is not available in SDI mode. "))
) ;_ end of cond
(princ)
) ;_ end of defun
(prompt "\n===To start press DOFILE within command prompt===")
(princ)
Auditing won't works using ObjectDBX interface.