(defun c:AECPOL (/ Laydef APOLY APLAY AWA APCOL)
  (setq LAYDEF (getvar "CLAYER") XECHO (getvar "CMDECHO"))(setvar "CMDECHO" 0)
  (while (not (setq APOLY (car(entsel ))) ))
  (setq APOLEL (entget APOLY))                                         ;Objektliste
  (setq APTYP (cdr (assoc 0  APOLEL)))                                 ;Objekttyp
  (if (= APTYP "AEC_POLYGON")(progn                                    ;Wenn AEC-POLYGON
  (setq APLAY (cdr (assoc 8 APOLEL)))                                  ;Objektlayer
  (setq APCOL (cdr (assoc 62 APOLEL)))                                 ;Objektfarbe
  (if (not APCOL)(setq APCOL "Bylayer"))                               ;Farbe "Bylayer"
  (setq APOLEL (subst (cons 8 "_APOLTEMP") (assoc 8 APOLEL) APOLEL ))  ;Objekt auf Temporären Layer verschieben
  (entmod APOLEL)
  (command "_.explode" APOLY )                                         ;AEC-POLY auflösen
  (Setq Apoly (cdr (assoc 2 (entget(entlast)))))                       ;Blockname merken
  (command "_.explode" (entlast) )                                     ;Block auflösen
  (command "_purge" "_bl" Apoly "_N")                                  ;Block löschen
  (setq Apoly (ssget "X"  '((8 . "_APOLTEMP"))) )                      ;Elemente sammeln
  (command "._change" Apoly "" "_p" "_la" APLAY "_p" "_c" APCOL "")    ;Layer und Farbe ändern
  (command "_pedit" "_m" Apoly "" "_Y" "_J" "0" "")                    ;Elemente vereinigen
  (command "_purge" "_la" "_APOLTEMP" "_N")                            ;Temporären Layer löschen
  )                                                                    ;endprogn
  (Alert "Objekt war kein AEC-POLYGON!") )                             ;endif
  (setvar "CLAYER" LAYDEF)(setvar "CMDECHO" Xecho) (princ)             ;Status wiederherstellen
  )