; Block hinzufügen mit Auswahl, Befehl: BLHA2
;
; vorheriger Blockname wird gehalten
;
; Bei nicht vorhandenem Blocknamen oder 
; Leertaste + Enter auf Wunsch Block-Auflistung
;
; Flaschenpost - cad.de - 21.02.2005

(defun C:BLHA2 (/ blwahl nr nbl2 nblock_neu nblock nfakt bln1 bln tbl_block)
 (block_auswahl2)
 (block_hinzufuegen2)
)  

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

(defun block_hinzufuegen2 () 
 
 (if (= nblock_name nil)
     (setq nblock_name "     " nbl2 "     ")
     (setq nbl2 nblock_name) 
     
 )
 
 (if (/= (setq nblock_neu (getstring T
     (strcat "\nBlockname, der hinzugefügt werden soll <" nblock_name "> : "))) "") 
     (setq nblock_name nblock_neu)
      
 )
 
 (if  (tblsearch "BLOCK" nblock_name)
      (progn 
          (initget 7)
          (setq nfakt (getreal "\nFaktor des neuen Blockes (gleicher Faktor xyz): "))  
          (setq nr -1)
          (repeat (sslength blwahl)
          (setq blockp (cdr (assoc 10 (entget (ssname blwahl (setq nr (1+ nr)))))) )
          (command "_.-insert" nblock_name "F" nfakt blockp "")
          );repeat
      );progn dann
     
      (progn 
      (initget "j n") 
      (if (= (getkword 
          (strcat "Blockname '" nblock_name "' 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)
          (if (= nblock_name " ")(setq nblock_name nbl2) )
          (block_hinzufuegen2)          
        );progn        
        (progn   
           (if (= nblock_name " ")(setq nblock_name nbl2) )
           (block_hinzufuegen2)     
        )
      );if 
           
      );progn sonst

 ); if
(princ)
);defun

(prompt "\nBlock hinzufügen mit Auswahl geladen (BLHA2), Blockauflistung Leertaste + Enter")
(princ)