;Blocktausch, Befehl: BLT
;
;Bei nicht vorhandenem Blocknamen
;oder Enter auf Wunsch Block-Auflistung
;
;Flaschenpost - cad.de - 23.01.05


(defun C:BLT (/ blwahl nr nblock_name nfakt nblock bln1 bln tbl_block)
 (block_auswahl)
 (block_tauschen)
)  

(defun block_auswahl ()
 (print "Blöcke wählen:") 
 
 (while (= (setq blwahl (ssget '((0 . "INSERT")))) nil)
        (print "Kein Block gewählt")
 )    
);defun   

(defun block_tauschen () 
 (if (and (setq nblock_name (getstring T "\nName des Blockes, der bestehende ersetzen soll: "))
          (tblsearch "BLOCK" nblock_name)  
     );and 
     (progn 
          (initget 7)
          (setq nfakt (getreal "\nFaktor des neuen Blockes (gleicher Faktor xyz): "))  
          (setq nr -1)
          (repeat (sslength blwahl)
          (setq block (entget (ssname blwahl (setq nr (1+ nr)))) )
          (setq nblock (subst (cons 2 nblock_name)(assoc 2 block) block ))
          (setq nblock (subst (cons 41 nfakt)(assoc 41 nblock) nblock ))
          (setq nblock (subst (cons 42 nfakt)(assoc 42 nblock) nblock ))
          (setq nblock (subst (cons 43 nfakt)(assoc 43 nblock) nblock ))
          (entmod nblock)
          );repeat
      );progn dann
     
      (progn 
      (initget "j n") 
      (if (= (getkword "Blockname unbekannt - Blocknamen auflisten ? [Ja/Nein]:") "j")
          (progn
           (setq bln1 (list (cdr (assoc 2 (tblnext "block" T)))) )
                    (while (/= (setq tbl_block (tblnext "block")) nil)
                      (if (/= (substr (cdr (assoc 2 tbl_block)) 1 1) "*")
                        (progn                      
                        (setq bln (cons (cdr (assoc 2 tbl_block)) bln1))
                        (setq bln1 bln)
                        )
                      )
                    )
           (reverse bln)   
           (print bln)
           (block_tauschen)          
           );progn        
           
           (block_tauschen)     
       );if 
           
      );progn sonst

 ); if
);defun