(defun C:BLOCK_COPY (/ #OLD_NAME# #NEW_NAME# blkl nblk nz)
  (prompt "\nBlock wählen: ")
  (setq #ob# (ssget "_:S" '((0 . "INSERT"))))
  (if #ob#
    (progn
      (setq #ob#       (ssname #ob# 0)
            #OLD_NAME# (cdr (assoc 2 (entget #ob#)))
            #el#       (tblobjname "BLOCK" #OLD_NAME#)
            nz         0
            )
      (while (if #NEW_NAME#
               (tblsearch "BLOCK" #NEW_NAME#)
               T
               )
        (setq #NEW_NAME#
               (strcat #OLD_NAME# "_" (itoa nz))
                                        ;(getstring "Blockname:")
              nz (1+ nz)
              )
        )
      (setq blkl (cons
                   (subst
                     (cons 2 #NEW_NAME#)
                     (assoc 2 (entget #el#))
                     (entget #el#)
                     )
                   blkl
                   )
            )
      (while (setq #el# (entnext #el#))
        (setq blkl (cons (entget #el#) blkl))
        )
      (mapcar 'entmake
              (mapcar '(lambda (L)
                         (vl-remove-if
                           '(lambda (W)
                              (member (car W) '(-1 330 -2 5))
                              )
                           L
                           )
                         )
                      (reverse blkl)
                      )
              )
      (setq nblk (entmake (list '(0 . "endblk"))))
      (if nblk
        (progn
          (princ (strcat "Block " nblk " Made"))
          (while #ob#
            (entmod (subst
                      (cons 2 #NEW_NAME#)
                      (cons 2 #OLD_NAME#)
                      (entget #ob#)
                      )
                    )
            (princ "\nBlock getauscht!")
            (initget "Ja Nein")
            (setq antw (getkword (strcat "\nweiteren Block durch "
                                         #NEW_NAME#
                                         " ersetzen? Ja/Nein <N>:"
                                         )
                                 )
                  )
            (if (= antw "Ja")
              (progn
                (prompt (strcat "\nBlock mit dem Namen "
                                (strcase #OLD_NAME#)
                                " wählen: "
                                )
                        )
                (setq #ob# (ssget "_:S"
                                  (list
                                    '(0 . "INSERT")
                                    (cons 2 #OLD_NAME#)
                                    )
                                  )
                      )
                (if #ob#
                  (setq #ob# (ssname #ob# 0))
                  (prompt "Keinen Block gewählt! - Ende!")
                  )
                )
              (setq #ob# nil)
              )
            )
          )
        (princ "Block NOT made")
        )
      )
    (prompt "Keinen Block gewählt! - Ende!")
    )
  )
(vl-load-com)
(princ "\n(defun - Lisp over night!")
(princ "\nhttp://www.defun.de")
(princ "\nBlock kopieren")
(princ "\nStart mit: BLOCK_COPY")