 ; Kibl - kill blocks by name or object selection.
 ; Copyright 1995 by Rocket Software 
 ; Not a word which conjures up images of heroic deeds.
 (DEFUN C:KIBL (/ hi bl ss len aa dell)
  (setvar "cmdecho" 0)
  (setq hi (getvar "highlight"))
  (setq bl (getstring "Name of block to kill or <Return> to select: "))
  (if (/= bl "")
      (progn
           (if (= (substr bl 1 1) "*")                ; escape * so that
               (setq bl (strcat "`" bl)))             ; can find hatches
           (setq ss (ssget "X" (list (cons 2 bl))))
           (setq bl (strcat (strcase (substr bl 1 1))
                    (strcase (substr bl 2) t)))
           (if ss
              (progn
                   (setq len (sslength ss))
                   (command "erase" ss "")
                   (if (= (substr bl 1 1) "`")      ; remove hatch * escape
                       (setq bl (substr bl 2)))   ; char ` if present
                   (prompt (strcat "\n" (itoa len) " " bl
                                   " insert" (if (/= len 1) "s" "")
                                   " erased.")))
              (prompt (strcat "\nNo " bl " inserts found."))))
      (progn
           (setq aa (entsel
                         "Select entity or <Return> to massacre all blocks:"))
           (if aa
              (progn
                   (if (setq aa (cdr (assoc 2 (entget (car aa)))))
                       (progn
                            (if (= (substr aa 1 1) "*")    ; escape * so that
                                (setq aa (strcat "`" aa))) ; can find hatches
                            (setq ss (ssget "X" (list (cons 2 aa))))
                            (setq aa (strcat (strcase (substr aa 1 1))
                                     (strcase (substr aa 2) t)))
                            (if ss
                               (progn          
                                    (setq len (sslength ss))
                                    (command "erase" ss "")
                                    (if (= (substr aa 1 1) "`") ; del hatch esc
                                        (setq aa (substr aa 2))); ` if present
                                    (prompt (strcat "\n" (itoa len) " " aa
                                             " insert" (if (/= len 1) "s" "")
                                             " erased.")))
                               (prompt (strcat "\nNo " aa " inserts found."))))
                       (write-line "\nThat was not a block.")))
              (progn
                   (initget 0 "Yes No")
                   (setq dell (getkword
                        "\nDo you understand what you are about to do? <Y>: "))
                   (if (/= dell "No")
                       (progn
                            (setq ss (ssget "X" '((0 . "INSERT"))))
                            (if ss 
                               (progn
                                    (setq len (sslength ss))
                                    (command "erase" ss "")
                                    (prompt (strcat "\n" (itoa len)
                                           " insert" (if (/= len 1) "s" "")
                                           " erased, you crazy fool.")))
                              (prompt "\nNo inserts found.")))
                       (write-line "\nCaution: a very commendable trait."))))))
  (setvar "highlight" hi)
 (princ))