home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / R11SUPP.EXE / DELLAYER.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1990-07-30  |  2.0 KB  |  54 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;; DELLAYER.LSP
  3. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  4. ;;;  
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.  
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  9. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  10. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;;
  12. ;;; --------------------------------------------------------------------------;
  13. ;;; DESCRIPTION
  14. ;;;
  15. ;;;   This program deletes all entities on specified layers.  Wildcards
  16. ;;;   can be specified.
  17. ;;;
  18. ;;; --------------------------------------------------------------------------;
  19.  
  20. (defun dellerr (s)                    ; If an error (such as CTRL-C) occurs
  21.                                       ; while this command is active...
  22.   (if (/= s "Function cancelled") 
  23.     (princ (strcat "\nError: " s))
  24.   ) 
  25.   (setq S nil)                        ; Free selection-set if any
  26.   (setvar "CMDECHO" ocmd)             ; Restore saved mode
  27.   (setq *error* olderr)               ; Restore old *error* handler
  28.   (princ)
  29. ) 
  30.  
  31. ;;; ------------------------- Main Program -----------------------------------;
  32.  
  33. (defun C:DELLAYER (/ olderr ocmd L S) 
  34.   (setq olderr *error* 
  35.         *error* dellerr)
  36.   (setq ocmd (getvar "CMDECHO"))
  37.   (setvar "CMDECHO" 0)
  38.   (setq L (strcase (getstring "\nLayer(s) to delete: ")))
  39.   ;; Get all entities on layer(s)
  40.   (setq S (ssget "X" (list (cons 8 L)))) 
  41.   (if S 
  42.     (command "ERASE" S "")            ; Delete 'em!
  43.     (princ "Layer empty or not a valid layer name.")
  44.   ) 
  45.   (setq S nil)                        ; Free selection-set
  46.   (setvar "CMDECHO" ocmd)             ; Restore saved mode
  47.   (setq *error* olderr)               ; Restore old *error* handler
  48.   (princ)
  49. ) 
  50.  
  51. ;;; --------------------------------------------------------------------------;
  52.  
  53.  
  54.