;;;Batch Purge drawings via BWBP, a WBLOCK technique.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 4-30-96
;;;>		   EDITED: 04-08-1997
;;;
(defun c:batp ( / )
  (setq dwgp (getvar"dwgprefix"))
  (setq plen (1+ (strlen dwgp)))
  (setq cdwg (getvar"dwgname"))
  (setq cdwgl (strlen cdwg))
  (if (getenv "LGN")
    (setq lognm (getenv "LGN"))
    (setq lognm "NN")
  );if
  (cond 
    ((eq(substr cdwg 2 1)":")(setq slen (+(strlen dwgp)1)))
    ((eq cdwgl 1)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 1)1)"\\")(setq slen cdwgl))
    ((eq cdwgl 2)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 2)1)"\\")(setq slen (- cdwgl 1)))
    ((eq cdwgl 3)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 3)1)"\\")(setq slen (- cdwgl 2)))
    ((eq cdwgl 4)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 4)1)"\\")(setq slen (- cdwgl 3)))
    ((eq cdwgl 5)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 5)1)"\\")(setq slen (- cdwgl 4)))
    ((eq cdwgl 6)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 6)1)"\\")(setq slen (- cdwgl 5)))
    ((eq cdwgl 7)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 7)1)"\\")(setq slen (- cdwgl 6)))
    ((eq cdwgl 8)(setq slen 1))
    ((eq (substr cdwg(- cdwgl 8)1)"\\")(setq slen (- cdwgl 7)))
    ((eq (substr cdwg(- cdwgl 9)1)"\\")(setq slen (- cdwgl 8)))
    ((eq(substr cdwg(- cdwgl 10)1)"\\")(setq slen (- cdwgl 9)))
    ((eq(substr cdwg(- cdwgl 11)1)"\\")(setq slen (- cdwgl 10)))
    ((eq slen nil)(setq slen 1))
  );cond
  (setq cdwg (strcat (getvar"dwgprefix")(substr cdwg slen)))
  (setq dfltr (ustr 1 "\nFile Selection String (*,? wildcards OK, no extension) " cdwg nil))
  (setq fltrl (strlen dfltr))
  (cond
    ((> fltrl 3)(if(eq (substr dfltr (- fltrl 3) 1) ".")
      (setq dfltr (substr dfltr 1 (- fltrl 4)))))
    ((> fltrl 2)(if(eq (substr dfltr (- fltrl 2) 1) ".")
      (setq dfltr (substr dfltr 1 (- fltrl 3)))))
    ((> fltrl 1)(if(eq (substr dfltr (- fltrl 1) 1) ".")
      (setq dfltr (substr dfltr 1 (- fltrl 2)))))
  );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 "|sort /+16 >" dwgp lognm "BATP.LST"))      ;use |sort/+nnn to specify char to start sort on
  (textscr)
  (command ".sh" dostr)
  (command ".sh" (strcat "type " dwgp lognm "BATP.LST|more"))
  (setq goprg (ukword 1 "Yes No Edit" "Purge these files or Edit list to purge? (Yes, No or Edit)" "Yes"))
  (if (eq goprg "Edit")
    (command ".sh" (strcat "ne " dwgp lognm "BATP.LST"))
  );if
  (setq qtdn (ukword 1 "Yes No" "Quit when done plotting? (Yes or No)" "No"))
  (if(not(eq goprg "No"))
    (progn
      (setq fp1 (open (strcat dwgp lognm "BATP.LST") "r"))
      (setq fp2 (open (strcat dwgp lognm "BATP.SCR") "w"))
      (write-line "(xunload\"amo\")" fp2)
      (while
        (setq nxln (read-line fp1))
        (setq nxll (strlen nxln))
        (if nxln
          (progn
            (setq opnst "OPEN Y"
                  prgst (strcat(substr nxln 1 (- nxll 3)) "DWG")
                  actst "(if c:bwbp nil (load\"bwbp\"))(c:bwbp)"
            );setq
            (write-line opnst fp2)
            (write-line prgst fp2)
            (write-line actst fp2)
          );progn
        );if
      );while
      (if (eq ilast cdwg)
        (progn
          (write-line "(graphscr)" fp2)
          (write-line "(xload\"z:/public/am/amo11/amo\")" fp2)
        );progn
      );if
    );progn
  );if
  (if (eq qtdn "Yes")
    (write-line "QUIT Y" fp2)
    (write-line (strcat "OPEN Y " cdwg) fp2)
  );if
  (graphscr)
  (if fp1 (close fp1))
  (if fp2 (close fp2))
  (command ".script" (strcat dwgp lognm "BATP"))
  (setvar "expert" 0)
  (setvar "filedia" 1)
  (setvar "osmode" osmod)
  (graphscr)
);defun