(defun c:NeuBlock (/ ss1 i1 ename edate NameAlt NameNeu) 
;;:angepasst 11.07.2006 westphal
;;;der neue blockname wird abgefragt

  (setq NameNeu (getstring "\nNeuer Blockname: "))

  (cond ((setq ss1 (ssget (list (cons 0 "INSERT"))))
  (setq i1 0) 
  (repeat (sslength ss1)
    (setq ename (ssname ss1 i1)
     edate (entget ename)
     NameAlt (cdr (assoc 2 edate))
;;;     NameNeu (HoleNeuenBlockName)
	i1 (1+ i1)
          )
  (if (KopiereBlock NameAlt NameNeu)
      (entmod (subst (cons 2 NameNeu) (assoc 2 edate) edate))
  )
)
)
  )
;;;alte bloecke eventuell bereinigen  
;;;  (command "-bereinig" "BL" "" "n")
 )
;
; Kopieren einer Blockdefinition
;
(defun KopiereBlock (alt neu / block ename edate ) 
  (setq block (tblsearch "BLOCK" alt))
  (setq ename (cdr (assoc -2 block)))
  
  (entmake)
  (entmake (subst (cons 2 neu) (assoc 2 block) block))
  (while ename
    (setq edate (entget ename))
    (entmake edate)
    (setq ename (entnext ename))
  )
  (entmake (list (cons 0 "ENDBLK")))
)