;;;This program will purge files in batch using a script file.
;;;The user specifies the [path\]filename search string (wildcards OK).
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 10-13-95
;;;>		   EDITED: 05-06-2001
;;;
(defun C:BPURGE ( / );fp1 fp2 fp3 fp4 item item1 str01 str1 str2 str3 dfltr fltrl pltfs fstr dostr cdwg gopurg svqt qtdn sdplt whplt ftscl tmplt tpltd tmplx
  (setvar "cmdecho" 0)
  (setvar "expert" 1)
  (setvar "filedia" 0)
  (setq dwgp (getvar"dwgprefix"))
  (setq dfltr (ustr 1 "\nFile Selection String (*,? wildcards OK, no extension) " "*" nil))
  (setq fltrl (strlen dfltr))
  (cond
    ((> fltrl 3)
      (if
        (eq (substr dfltr (- fltrl 3) 1) ".")
          (setq dfltr (substr dfltr 1 (- fltrl 4)))
      );if
    )
    ((> fltrl 2)
      (if
        (eq (substr dfltr (- fltrl 2) 1) ".")
          (setq dfltr (substr dfltr 1 (- fltrl 3)))
      );if
    )
    ((> fltrl 1)
      (if
        (eq (substr dfltr (- fltrl 1) 1) ".")
          (setq dfltr (substr dfltr 1 (- fltrl 2)))
      );if
    )
  );cond
  (if (eq ":" (substr dfltr 2 1))
    nil
    (setq dfltr (strcat (getvar"dwgprefix")dfltr))
  );if
  (setq fstr (strcat dfltr ".DWG"))
      (setq dostr (strcat "dir /b /o /s " fstr ">" dwgp "BPURGE.LST"))      ;use |sort/+nnn to specify char to start sort on
      (textscr)
      (command ".sh" dostr)
      (command ".sh" (strcat "type " dwgp "BPURGE.LST|more"))
      (setq gopurg (ukword 1 "Yes No Edit" "BPURGE these files or Edit list to BPURGE? (Yes, No or Edit)" "Yes"))
      (if
        (eq "Edit" gopurg)
          (command ".sh" (strcat "edit " dwgp "BPURGE.LST"))
      );if
      (if (or(eq "Yes" gopurg)(eq "Edit" gopurg))
        (progn
          (setq bpgin (open (strcat dwgp "BPURGE.LST") "r"))
          (setq bpgout (open (strcat dwgp "BPURGE.SCR") "w"))
;          (if (= (getvar"dbmod") 0)
            (write-line ".OPEN" bpgout)
;            (write-line ".OPEN Y" bpgout)
;          );if
          (while
            (setq nxln (read-line bpgin))
            (setq nxll (strlen nxln))
            (if nxln
              (progn
                (write-line (strcat "Y "(substr nxln 1 (- nxll 3)) "DWG") bpgout)
                (write-line "(load\"wblkp\")" bpgout)
                (write-line "(wblkp)" bpgout)
              );progn
            );if
          );while
          (close bpgin)
          (close bpgout)
          (setvar "cmdecho" 1)
          (command ".script" (strcat dwgp "BPURGE"))
        );progn
      );if
  (setvar "expert" 0)
  (setvar "filedia" 1)
  (graphscr)
);defun