;Title - Erin Stephens Lisp Page
;Lisp Page from Internet - Internet Worldwide Communications
 ;PURGEB.LSP  [8/10/95]
 ;
 ; freeware by:
 ;   Owen Wengerd
 ;   Manu-Soft Computer Services
 ;   CompuServe:  71324,3252
 ;
 ; Load function, then enter PURGEB to purge all unreferenced blocks
 ;  (including nested blocks)
 ;

 (defun c:purgeb (/ cnt pb)

   (defun pb (/ flag)

     (command "._PURGE" "_B") ;Change "_B" to purge other items ("_A" for 'All')

     (while (not (zerop (getvar "CMDACTIVE")))
       (command "Y")
       (setq flag (setq cnt (1+ cnt)))
     )
     flag
   )

   (setvar "CMDECHO" 0)
   (while (not (zerop (getvar "CMDACTIVE"))) (command))
   (setq cnt 0)
   (while (pb))
   (if (not (zerop cnt))
     (princ
       (strcat "\n \n \n  "
               (itoa cnt)
               " Unreferenced Block" ;Change "Block" to other object name
               (if (> cnt 1) "s" "")
               " Purged!"
       )
     )
   )
   (princ)
 )
 ;End-of-file