Rutina para purgar archivos de una ruta indicada

Ver el tema anterior Ver el tema siguiente Ir abajo

Rutina para purgar archivos de una ruta indicada

Mensaje por cyberfantasma el Mar Oct 04, 2016 11:21 pm

Estimados
tengo esta rutina que purga todos los ficheros de una determinada carpeta es muy útil, el problema es que no purga las escalas que no estoy utilizando, lo que me obliga a utilizar una segunda y hacerlo manualmente, me agradaría pudieran darme una mano y tratar de juntar estas dos rutinas en una sola, y que finalmente también purgue la lista de escalas. muy agradecido por la ayuda

La primera rutina es la siguiente:

;;; Esta rutina purga archivos dwg de la carpeta seleccionada

(vl-load-com)

(defun c:PUA () (c:PurgeAuditFiles))
(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 "\nbuscar en subcarpetas? 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 " & "\narchivo de dibujo creado con una versión incompatible. ")))
  );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 "\nTeclea PurgeAuditFiles para llamar al comando")


la segunda rutina es la siguiente:

;;; Esta rutina elimina escalas no utilizadas de los archivos dwg

(defun c:PUS () (c:Purgelistscale))
(defun c:Purgelistscale (/)

(command "_.-scalelistedit" "_r" "n" "_d" "*" "e")
);end c:Purgelistscale

(prompt "\nTeclea Purgelistscale para llamar al comando")

cyberfantasma

Mensajes : 6
Fecha de inscripción : 22/06/2016

Ver perfil de usuario

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.