;;;;
;;;;  LISP - ROUTINE   (ersetzen eines Blockes)
;;;;
;;;;  Mit dieser Routine wird ein Block durch einen anderen ersetzt,
;;;;  wobei die Attributwerte übernommen werden.
;;;;  Block wird auf den aktuellen Layer eingefügt
;;;;  
;;;;______________________________________________________________________________


(defun
     C:VBL-L (/)
;;;     (/ Attrib Attribliste ep ele1 ele ell aws anz za AttWert blocknam)
  (setq lay_old (getvar "CLAYER"))
  (setq osmodold (getvar "OSMODE")) ;22.12.99
  (princ "\n\n>>> Ersetzen eines Blockes durch einen Anderen © by Mario Tröger<<<\n")
  (princ "\n    Block wird auf dem aktuellen Layer eingefügt !")
  (setq blocknam nil)
  (princ "\n>Wählen Sie die zu ersetzenden Blöcke : ")
  (setq aws (ssget (list (cons 0 "INSERT") (cons 66 1))))
  (setq ele1 (ssname aws 0))
  (setq blocknam (cdr (assoc 2 (entget ele1))))
  (if (= blocknam nil)
    (setq blocknam "*")
  ) ;_ Ende von if
  (if aws
    (setq anz (sslength aws))
    (setq anz 0)
  ) ;_ Ende von if
  (princ "\n")
  (princ anz)
  (princ "  Elemente von BLOCK >")
  (princ blocknam)
  (princ "< gefunden.")
  (princ "\n")
  (initget 1)
  (setq gbln (getstring "\nNeuer Block : "))
  (setq ef (getreal "\nEinfügefaktor = 1 eingeben : "))
  (if aws
    (princ "\nElemente werden geändert ...")
  ) ;_ Ende von if
  (setq za 0)
  (repeat anz
    (setq ele (ssname aws za))
    (setq za  (+ 1 za)) ;_ Ende von setq
    (setq Attribliste nil)
    (setq ep (cdr (assoc 10 (entget ele))))
    (setq AttWert (entnext ele))
    (setq attrib1 T)
    (while (/= Attrib1 nil)
      (setq Attrib (cdr (assoc 1 (entget AttWert))))
      (if (= Attrib nil)
      (setq Attrib1 nil)
      (setq Attribliste (append Attribliste (list (strcat Attrib))))
	)
      (setq AttWert (entnext AttWert))
    ) ;_ Ende von while
    (setvar "OSMODE" 0) ;22.12.99
;;;    (command "-EINFÜGE" gbln ep ef "" "" (mapcar 'lambda Attribliste))
;;;    (command "-EINFÜGE" gbln ep ef "" ""  Attribliste )

    (setq cmd (list 0 ef ef 'ep gbln "_-INSERT" 'command))
    (foreach n Attribliste
      (setq cmd (cons n cmd))
      )
    (eval(reverse cmd))
  
    (princ " ** ende einfügen ** ")
    (setvar "CLAYER" lay_old)
    (command "LÖSCHEN" ele "")
  ) ;_ Ende von repeat
  (entupd ele)
  (if aws
    (princ "\nÄndern beendet !")
  ) ;_ Ende von if
  (setvar "OSMODE" osmodold) ;22.12.99
  (princ)
) ;_ Ende von defun