(defun c:mbl ( / index)
  (prompt "**** Block mit Properties bilden *******")
  (prompt "")
  (setq auswahl-satz nil)
  (setq auswahl-satz (ssget))
  (setq PT0 (getpoint "\nUrsprung antippen: "))
  (bl-name PT0) ; block-kennung ermitteln (in SSTBASE)
  (setq index 0.0)
  (while (< index (sslength auswahl-satz))          ; Anfang WHILE
    (setq E (ssname auswahl-satz index))            ; Entity-Name setzen
    (setq blockname (cdr (assoc 2 (entget e))))     ; BLOCKNAME ermitteln
    (print blockname)                               ; Blockname drucken
    (print E)                                       ; und auf SCRREN anzeigen
    (setq TYP (cdr (assoc 0 (entget E))))           ; Objekt-ART 
    (if
      (and
        (equal typ "INSERT")                        ; wenn BLOCK
        (equal (cdr (assoc 66 (entget e))) 1)       ; und ATTRIBUTE vorhanden
      )
      (progn                                        ; dann
        (einzel-attr-aendern "C" block-kennung 0)   ; oberen Block „ndern
        (setq OBJ1   (tblsearch "BLOCK" blockname)) ; in der Blocktabelle suchen
        (setq OBJEKT (cdr (assoc -2 OBJ1)))         ; n„chstes Objekt
        (princ OBJ1)
        (while OBJEKT                               ; f�r alle Objekte des Blockes
;          (einzel-attr-aendern "C" block-kennung 0)  
;          (setq typ1 (cdr (assoc 0 (entget OBJEKT))))
          (setq typ2 (cdr (assoc 2 (entget OBJEKT))))
          (if (equal typ2 "C")
            (entmod (subst (cons 1 block-kennung) (assoc 1 (entget OBJEKT)) (entget OBJEKT)))
          )  
          (setq OBJEKT (entnext OBJEKT))           ; n„chstes Objekt
        )                                          ; ende WHILE f�r alle Objekte des Blockes
      )
    )
    (setq index (1+ index))
  )                                                 ; ende WHILE
  (princ)
  (mach-block PT0 "0" auswahl-satz)
  (attribute-aendern "0" "2" "1" "" "" block-kennung "" "" "" "")  ; in SSTBASE.LSP
  (setq auswahl-satz nil)
)






;(defun c:blockliste (/ datei block objekt)
;  (setq datei (open (strcat (getvar "DWGNAME") ".BLK") "w"))
;  (setq block (tblnext "BLOCK" t))
;  (while block
;    (print block datei)
;    (setq objekt (cdr (assoc -2 block)))
;    (while objekt
;      (print (entget objekt) datei)
;      (setq objekt (entnext objekt))
;    )
;    (setq block (tblnext "BLOCK"))
;  )
;  (close datei)
;  (princ)
;)