Dear friends, I ask for help to modify this routine, I asked for help from the author but I did not receive any response. I hope you have no problem helping me. What I really want is to add the ETRANSMIT routine to your routine in such a way that it generates a zip file for each file Dwg to clean, very grateful for the support, regards.
;;;CADALYST 03/05 Tip2023: PurgeFiles.lsp Directory Clean Up (c) Andrzej Gumula
;;; [c]2004 Andrzej Gumula, Katowice, Poland
;;; e-mail: a.gumula@wp.pl
;;; This routine purge dwg files from selected folder
(vl-load-com)
(defun c:PurgeFiles (/ 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)
(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. ")
(prompt "\n[c]2004 Andrzej Gumula. ")
(princ)
