home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / mar94cad.zip / TIP962A.LSP < prev    next >
Lisp/Scheme  |  1994-02-15  |  4KB  |  123 lines
  1. ; TIP962A.LSP: DDELAYER.LSP   Delete by Layers    (c)1994, Mike Aaly
  2.  
  3. (defun err (er)                                    
  4.    (if (/= er "Function cancelled")
  5.    (princ (strcat "\nError: "er)))
  6.    (setq er nil)
  7.    (setvar "CMDECHO" ocmd)
  8.    (setq *error* olderr)
  9.    (princ)
  10. )
  11. ;
  12. (defun C:DDELAYER (/ olderr ocmd ALL SL id SLL ss) 
  13.    (setq SLL '())                                  
  14.    (setq olderr *error* *error* err)               
  15.    (setq ocmd (getvar "CMDECHO"))
  16.    (setvar "CMDECHO" 0)
  17.    (while                                          
  18.       (setq lsts (cdr(assoc 2 (tblnext "LAYER" (not lsts))))) 
  19.       (setq ALL (cons lsts ALL))                    
  20.    )                                                
  21.    (if (= (type acad_strlsort) 'EXSUBR)             
  22.       (if (and ALL (>= (getvar "maxsort") (length ALL)))
  23.          (setq ALL (acad_strlsort ALL))                  
  24.       )                                                  
  25.    )                                           
  26.    (setq id (load_dialog "DDELAYER")) 
  27.    (new_dialog "DDELAYER" id)         
  28.    (mode_tile "accept" 1)                  
  29.    (mode_tile "C_A" 1)                     
  30.    ;
  31.    (defun Make_List ()                      
  32.       (start_list "SL")                    
  33.       (foreach n ALL (add_list n))
  34.       (end_list)
  35.    )
  36.    ;
  37.    (defun SEL_ALL ()                
  38.       (setq CT1 0)                  
  39.       (repeat (length ALL)          
  40.          (set_tile "SL" (itoa CT1))
  41.          (setq CT1 (1+ CT1))
  42.       )                             
  43.       (mode_tile "S_A" 1)           
  44.       (mode_tile "C_A" 0)           
  45.       (mode_tile "accept" 0)        
  46.       (SM)                           
  47.    )
  48.    ;
  49.    (defun CLEAR_ALL ()               
  50.       (set_tile "SL" "")             
  51.       (mode_tile "C_A" 1)             
  52.       (mode_tile "S_A" 0)             
  53.       (mode_tile "accept" 1)          
  54.       (setq SLL '())                  
  55.       (Make_List)                     
  56.    )
  57.    ;
  58.    (defun Select ()                   
  59.       (SM)                            
  60.       (if (= (length SLL) (length ALL))
  61.          (mode_tile "S_A" 1)           
  62.          (mode_tile "S_A" 0)
  63.       )
  64.       (if (/= (get_tile "SL") "")      
  65.          (progn                        
  66.             (mode_tile "accept" 0)
  67.             (mode_tile "C_A" 0)
  68.          )
  69.          (progn                         
  70.             (mode_tile "accept" 1)
  71.             (mode_tile "C_A" 1)
  72.          )
  73.       )
  74.    )
  75.    ;
  76.    (defun SM (/ SDL PL ct)                   
  77.       (setq SDL (get_tile "SL") SLL '())      
  78.       (setq ct 1 PL "" SDL (strcat SDL " "))  
  79.       (while (/= ct (1+ (strlen SDL)))
  80.          (if (/= (substr SDL ct 1) " ")
  81.             (setq PL (strcat PL (substr SDL ct 1)))
  82.             (progn                                          
  83.                (setq SLL (cons (nth (atoi PL) ALL) SLL))
  84.                (setq PL "")                             
  85.             )
  86.          )
  87.          (setq ct (1+ ct))
  88.       )                                                
  89.    )
  90.    ; 
  91.    (Make_List)                                         
  92.    (action_tile "SL" "(Select)")
  93.    (action_tile "cancel" "(setq SLL '()) (done_dialog)")
  94.    (action_tile "S_A" "(SEL_ALL)")
  95.    (action_tile "C_A" "(CLEAR_ALL)")
  96.    (action_tile "accept" "done_dialog")
  97.    (start_dialog)                               
  98.    (unload_dialog id)                          
  99.    (if (/= SLL nil)                            
  100.       (progn                                   
  101.          (setq flag nil)                       
  102.          (foreach n SLL                        
  103.             (setq ss (ssget "X" (list (cons 8 n))))  
  104.             (if (/= ss nil)                          
  105.                (progn
  106.                   (setq flag T)
  107.                   (princ (strcat "\nDeleting layer " n))
  108.                   (command "erase" ss "")            
  109.                )
  110.             )                                             
  111.          ) 
  112.          (if flag
  113.             (princ "\nDone!")
  114.             (princ "\nNothing to delete")
  115.          )
  116.       )                                            
  117.    )
  118.    (setvar "CMDECHO" ocmd)                  
  119.    (setq *error* olderr)                    
  120.    (princ)                                  
  121. ); end ddelayer.lsp
  122.  
  123.