(prompt "\nStarten mit benennUBL\nUm alle Unbenannten Blöcke zu benennen, bitte * eingeben\n")
(defun C:benennUBl (/ what)
  (vl-load-com)
  (if (setq what (getstring "\nwelche Blöcke sollen Benannt werden? :"))
    (progn
      (cond
        ((= (substr what (strlen what) (- (strlen what) 1)) "*")
         (if
           (/= (substr what 1 1) "*")
            (setq what (strcat "*" what))
            ) ;_ end of if
         (suchbtable (strcase what))
         )
        (T
         (if
           (/= (substr what 1 1) "*")
            (setq what (strcat "*" what))
            ) ;_ end of if
         (suchbtable (strcase what))
         )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

(defun suchbtable (muster    /         b         anz       f
                   x         what      AN_BLOCK_LISTE      blnewname
                   zaehler   geswert
                   )
  (setq x (tblnext "BLOCK" T)
        geswert 0
        )                               ; get first block definition
  (while x
    (setq b       (cdr (assoc 2 x))     ; block name
          f       (cdr (assoc 70 x))    ; flags
          zaehler 0
          ) ;_ end of setq
    (cond
      ((= 1 (logand f 1))
       (if (wcmatch b muster)
         (setq AN_BLOCK_LISTE
                (cons
                  (list b)
                  AN_BLOCK_LISTE
                  ) ;_ end of cons
               ) ;_ end of setq
         ) ;_ end of if
       )
      ) ;_ end of cond
    (setq x (tblnext "BLOCK"))
    ) ;_ end of while
  (foreach item AN_BLOCK_LISTE
    (setq blnewname (substr (car item) 2))
    (while (/= (tblsearch "BLOCK" blnewname) nil)
      (setq blnewname (strcat blnewname (itoa zaehler)))
      ) ;_ end of while
    (cop_blk (car item) blnewname)
    (if(setq wert (ren_blk (car item) blnewname))
    (setq geswert (+ geswert wert))
      )
    ) ;_ end of foreach
  (princ (strcat (if (null AN_BLOCK_LISTE)
                   "0"
                   (itoa (length AN_BLOCK_LISTE))
                   ) ;_ end of if
                 " Blöcke und "
                 (itoa geswert)
                 " Insert's benannt"
                 ) ;_ end of strcat
         ) ;_ end of princ
  ) ;_ end of defun


(defun cop_blk (bna bnn / a_app a_doc a_blks i blk inspt cnt newfil)

  (setq a_app  (VLAX-GET-ACAD-OBJECT)
        a_doc  (vla-get-ActiveDocument a_app)
        a_blks (vla-get-blocks a_doc)
        i      0
        blk    (vla-item a_blks bna)
        inspt  (vla-get-origin blk)
        cnt    (- (vla-get-count blk) 1)
        newfil (vlax-make-safearray vlax-vbobject (cons 0 cnt))
        ) ;_ ende von setq
  (vlax-for ent blk
    (vlax-safearray-put-element newfil i ent)
    (setq i (1+ i))
    ) ;_ ende von vlax-for
  (setq newblk (vla-add a_blks inspt bnn))
  (vla-copyobjects a_doc newfil newblk nil)
  (princ)
  ) ;_ ende von defun

(defun ren_blk (bna bnn / as zaehl ename)
  (if
    (setq as (ssget "X" (list (cons 2 (strcat "`" bna)))))
     (progn
       (setq zaehl (sslength as))
       (repeat zaehl
         (setq ename (entget (ssname as 0)))
         (setq ename (subst (cons 2 bnn) (assoc 2 ename) ename))
         (entmod ename)
         (setq as (ssdel (ssname as 0) as))
         ) ;_ end of repeat
       ) ;_ end of progn
     ) ;_ end of if
  zaehl
  ) ;_ end of defun

;|«Visual LISP© Format Options»
(72 2 40 1 T "end of " 60 9 0 0 0 nil T nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;