(defun c:NeuBlock (/ ss1 i1 ename edate NameAlt NameNeu) 
;;:angepasst 11.07.2006 westphal
;;;der neue blockname wird abgefragt
;;;alte bloecke werden bereinigt  
  (setq NameNeu (getstring "Neuer 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))
  )
)
)
  )
;;;bereinigen
;;;  (command "-bereinig" "BL" "" "n")
 )
;
; Erstellen eines neuen Blocknames aufgrund Datum Uhrzeit
;
;;;(defun HoleNeuenBlockName (/ a1)
;;;  (while (tblsearch "BLOCK" (setq a1 (strcat "NeuerBlockName-" (replace (rtos (getvar "CDATE") 2 6) "." "")))))
;;;  a1
;;;)
;
; ersetzten eines strings in einem string
;
(defun Replace (String SearchString ReplaceString / )
  (while (/= String (vl-string-subst ReplaceString SearchString String))
    (setq String (vl-string-subst ReplaceString SearchString String))
  )
String
)
;
; 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")))
)