;;;Deletes all entities on specified layers.  Accepts wildcards.
;;; --------------------------------------------------------------------------;
;;;   DELLAYER.lsp
;;;
;;;   Permission to use, copy, modify, and distribute this software
;;;   for any purpose and without fee is hereby granted, provided
;;;   all supporting documentation.
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;   Version 2.0
;;; --------------------------------------------------------------------------;
;;;   DESCRIPTION
;;;
;;;   This program deletes all entities on specified layers.  Wildcards
;;;   can be specified.
;;;
;;;   Version 2.0 has been updated to delete entities in both paper
;;;   space and modelspace. An additional prompt has been added to
;;;   prepare a layer for purging. If desired, the layer(s) will be
;;;   thawed and turned off, to make purging possible.
;;;   Script files using earlier versions of this routine must be
;;;   updated to accomodate the extra prompt.
;;;
;;; --------------------------------------------------------------------------;

(defun dellerr (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setq sset_1 nil)                   ; Free selection-sets if any
  (setq sset_2 nil)
  (setvar "CMDECHO" ocmd)             ; Restore saved mode
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)


(defun c:DL ( / sset_1 sset_2 prg num count ex)
   (setq olderr *error*
        *error* dellerr)

   (setq ocmd (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)

   (setq lname (strcase (getstring "\nLayer(s) to delete: ")))

   ;; Get all entities on layer(s)
   (setq sset_1 (ssget "X" (list (cons 8 lname))))

   (if sset_1
      (progn
         (initget "Yes No")
         (setq prg (getkword "\nPrepare the layer(s) for purging <Y>/N:"))
         (if (= prg nil) (setq prg "Yes"))
         (setq num (sslength sset_1))

         (setq count 0)                      ;delete the entities
         (repeat (sslength sset_1)
            (entdel (ssname sset_1 count))
            (setq count (1+ count))
         )

         ;Check that everything is gone
         (if
            (ssget "X" (list (cons 8 lname)))
            ;And if anything is left
            (progn
              (setq tm (getvar "tilemode"))
                (if (= 1 tm)
                  (setvar "tilemode" 0)
                )
                ;Go to paperspace
                (if (/= 1 (getvar "cvport"))
                 (progn
                  (princ "\nSwitching to paper space.")
                  (command "_.pspace")
                 )
                )
                ;And try again
                (setq sset_2 (ssget "X" (list (cons 8 lname))))
                (setq count 0)
                 (repeat (sslength sset_2)
                   (entdel (ssname sset_2 count))
                   (setq count (1+ count))
                 )
              (setvar "tilemode" tm)
            )
         )

         (if (= prg "Yes")
           (progn
             ; Prep the layer for purging
             ; Turn off, thaw, and unlock layer(s)
             (setq ex (getvar "expert"))
             (setvar "expert" 5)
             (command "_.layer" "_off" lname "_thaw" lname "")
               (if (= 0 (getvar "tilemode"))
                 (command "_.vplayer" "_vpvisdflt" lname "_thaw" "_reset"
                 lname "_all" "")
               )
             (princ "\n")(princ num)(princ " entities on layer(s) ")
             (princ lname)(princ " deleted.")(princ "\nLayer(s) ") (princ lname)
             (princ " is thawed, turned off, and purgeable.")
             (setvar "expert" ex)
           )
           (progn
             (princ "\n")(princ num)(princ " entities on layer(s) ")
             (princ lname)(princ " deleted.")
           )
         )
      )

      (princ "Layer empty or not a valid layer name.")
   )

   (setq sset_1 nil)                   ; Free selection-sets
   (setq sset_2 nil)
   (setvar "CMDECHO" ocmd)             ; Restore saved mode
   (setq *error* olderr)               ; Restore old *error* handler
   (princ)
)