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


(defun C:BLHA (/ blwahl nr nbl2 nblock_neu nblock nfakt bln1 bln tbl_block)
 (block_auswahl)
 (block_hinzufuegen)
)  

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

(defun block_hinzufuegen () 
 
 (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 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 ))
          (setq nblock (subst (cons 8 (getvar "CLAYER"))(assoc 8 nblock) nblock ))
          (entmake nblock)
          );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_hinzufuegen)          
        );progn        
        (progn   
           (if (= nblock_name " ")(setq nblock_name nbl2) )
           (block_hinzufuegen)     
        )
      );if 
           
      );progn sonst

 ); if
(princ)
);defun

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