Dear
I have this lisp purge all files in a particular folder is very useful, the problem is that not purge the scales I'm not using, forcing me to use a second lisp and do it manually, I would like you could give me a hand and try to bring together these two lisp into one, and eventually also purge the list of scales. very grateful for the help
The first lisp is:
;;; This lisp purge dwg files from selected folder
(vl-load-com)
(defun c:PurgeAuditFiles (/ FilesList DwgPath 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 ""))
(cond
((not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list Dir 'Items))))
(setq Item (vlax-invoke-method (vlax-invoke-method Dir 'Items) 'Item))
(setq Path (vla-get-path Item))
(if (not (member (substr Path (strlen Path) 1) (list "/" "\\")))
(setq Path (strcat Path "\\"))
);end if
)
);end cond
)
);end cond
Path
);end GetFolder
(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 if
)
(reverse AllPath)
);end vl-findfile
(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)))
(foreach Item TmpList (MakeDirList (strcat Arg "/" Item)))
)
);end cond
);end MakeDirList
(if (not FileSystemObject)
(setq FileSystemObject (vla-getInterfaceObject (vlax-get-acad-object) "Scripting.FileSystemObject"))
);end if
(cond
((= (getvar "SDI") 0)
(cond
((setq DwgPath (GetFolder))
(initget "Yes No")
(setq Subdir (cond ((getkword "\nLooking for subfolders? No,[Yes]: "))
(T "Yes")))
(if (equal SubDir "Yes")
(setq Files (vl-findfile (substr DwgPath 1 (1- (strlen DwgPath)))))
(setq Files (mapcar '(lambda (x) (strcat dwgpath x))(vl-directory-files DwgPath "*.dwg" 1)))
);end 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)))
(foreach & Files
(cond
((not (member & FilesList ))
(cond
((/= (logand (vlax-get-property (vlax-invoke-method FileSystemObject 'getfile &) 'Attributes) 1) 1)
(cond
((setq File (vla-open (vla-get-documents (vlax-get-acad-object)) &))
(prompt (strcat "\nPurge " & ". Please wait..."))
(vla-purgeall File)
(vla-AuditInfo File T)
(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 cond
)
(T (prompt (strcat & " is read-only. Purge canceled. ")))
);end cond
)
(T (prompt (strcat & " is open now. Purge canceled. ")))
);end cond
);end foreach
)
(T (prompt "\nNothing files found to purge. "))
);end cond
)
(T (prompt "\nNothing selected. "))
);end cond
)
(T (prompt "\nThe routine is not available in SDI mode. "))
);end cond
(princ)
);end c:PurgeFile
(prompt "\nLoaded new command PurgeFiles. ")
(princ)
The second lisp is:
;;; This routine removes unused files scales
(defun c:PUS () (c:Purgelistscale))
(defun c:Purgelistscale (/)
(command "_.-scalelistedit" "_r" "n" "_d" "*" "e")
);end c:Purgelistscale
(prompt "\nLoaded new command Purgelistscale. ")
(princ)
Thanks for the help
