;*************************************************************************
;** Datei ATTRTXT.LSP							  
;** Dient zum Umwandeln von sichtbaren Blockattributen in Text		  
;*************************************************************************
;** Funktionen								  
;** C:ATTRTOTXT_EXP    Wandelt sichtbare Blockattribute in Text um und	  
;**                    zerlegt den Block				  
;** C:ATTRTOTXT_NOEXP  Wandelt sichtbare Blockattribute in Text und setzt 
;**                    alle Attributwerte des Blocks auf "", der Block	  
;**                    wird nicht zerlegt				  
;*************************************************************************
;** Autor: NAVRATIL Heinz						  
;** Stand: 04.11.1998							  
;** email: hnavratil@KGH.KABA.com					  
;*************************************************************************
;** Update/Bugfixing Udo Hübner Udo@CAD-Huebner.de 10.09.09		  
;** getestet mit AutoCAD 2008						  
;** Update/Bugfixing CADffm 13.09.09					  
;*************************************************************************


;** ----------------------------------------------------------------------
;** C:ATTRTOTXT_EXP							  
;** ----------------------------------------------------------------------

(defun C:attrtotxt_exp ( / as i e el bn nl l1 l2)
  (if (setq as (ssget))
    (progn
      (setq i 0)
      (while (setq e (ssname as i))
        (setq el (entget e))
        (if (/= (assoc 66 el) nil)
          (progn
            (setq bn e)
            (while (/= (cdr (assoc 0 (setq el (entget e)))) "SEQEND")
              (if (and (= (cdr (assoc 0 el)) "ATTRIB")
                      (/= (logand (cdr (assoc 70 el)) 1) 1)
                  )
                (progn
                  (setq nl (cdr el))
                  (setq nl (subst '(0 . "TEXT") (assoc 0 nl) nl))
                  (setq l1 (cdr (member (assoc 2 nl) nl)))
                  (setq l2 (reverse (cdr (member (assoc 2 nl) (reverse nl)))))
                  (setq nl (append l2 l1))
                  (setq l1 (cdr (member (assoc 70 nl) nl)))
                  (setq l2 (reverse (cdr (member (assoc 70 nl) (reverse nl)))))
                  (setq nl (append l2 l1))
                  (setq nl (subst (cons 73 (cdr (assoc 74 nl))) (assoc 74 nl) nl))
                  ; CADffm1: Alle 280er entfernt
                  (while (assoc 280 nl)(setq nl (vl-remove (assoc 280 nl) nl)))     
                  (entmake nl)
                )
              )
              (setq e (entnext e))
            )
            (setq le (entlast))
            (command "._EXPLODE" bn)
            (while (setq le (entnext le))
              (if (= (cdr (assoc 0 (entget le))) "ATTDEF")
                (entdel le)
              )
            )
          )
        )
        (setq i (1+ i))
      )
      (command "._REGEN")
    )
  )
  'DANKE
)


;** ----------------------------------------------------------------------
;** C:ATTRTOTXT_NOEXP							  
;** ----------------------------------------------------------------------

(defun C:attrtotxt_noexp ( / as i e el bn nl l1 l2)
  (if (setq as (ssget))
    (progn
      (setq i 0)
      (while (setq e (ssname as i))
        (setq el (entget e))
        (if (/= (assoc 66 el) nil)
          (progn
            (setq bn e)
            (while (/= (cdr (assoc 0 (setq el (entget e)))) "SEQEND")
              (if (and (= (cdr (assoc 0 el)) "ATTRIB")
                      (/= (logand (cdr (assoc 70 el)) 1) 1)
                  )
                (progn
                  (setq nl (cdr el))
                  (setq nl (subst '(0 . "TEXT") (assoc 0 nl) nl))
                  (setq l1 (cdr (member (assoc 2 nl) nl)))
                  (setq l2 (reverse (cdr (member (assoc 2 nl) (reverse nl)))))
                  (setq nl (append l2 l1))
                  (setq l1 (cdr (member (assoc 70 nl) nl)))
                  (setq l2 (reverse (cdr (member (assoc 70 nl) (reverse nl)))))
                  (setq nl (append l2 l1))
                  (setq nl (subst (cons 73 (cdr (assoc 74 nl))) (assoc 74 nl) nl))
               
                  ; Eintrag Code 280 aus neueren Attributsdef. für den Text entfernen
                  ; www.CAD-Huebner.de  10.09.09
                  ; CADffm1: Alle 280er entfernt
                  (while (assoc 280 nl)(setq nl (vl-remove (assoc 280 nl) nl)))                 
                  (entmake nl)
                ; hier noch BUG korrigiert assoc 1 el statt assoc 2 el
                  (setq el (subst '(1 . "") (assoc 1 el) el))
                  (entmod el)
                )
              )
              (setq e (entnext e))
            )
          )
        )
        (entupd bn)
        (setq i (1+ i))
      )
      (command "._REGEN")
    )
  )
  'DANKE
)

(princ "\nAufruf mit: attrtotxt_exp oder attrtotxt_noexp\n")
(princ)