;;; Lee Mac Convert Attribute Definition to Text

(defun c:ADT ( / ss )
;; © Lee Mac ~ 01.06.10
(vl-load-com)

(if (setq ss (ssget "_:L" '((0 . "ATTDEF"))))
(
(lambda ( i / e o )
(while (setq e (ssname ss (setq i (1+ i))))
(if
(
(if (and (vlax-property-available-p
(setq o (vlax-ename->vla-object e)) 'MTextAttribute)
(eq :vlax-true (vla-get-MTextAttribute o)))

MAttDef2MText AttDef2Text
)
(entget e)
)
(entdel e)
)
)
)
-1
)
)
(princ)
)

(defun AttDef2Text ( eLst / dx74 dx2 )
;; © Lee Mac ~ 01.06.10

(setq dx74 (cdr (assoc 74 eLst)) dx2 (cdr (assoc 2 eLst)))

(entmake
(append '( (0 . "TEXT") ) (RemovePairs '(0 100 1 2 3 73 74 70 280) eLst)
(list
(cons 73 dx74)
(cons 1 dx2)
)
)
)
)

(defun MAttDef2MText ( eLst )
;; © Lee Mac ~ 01.06.10

(entmake
(append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") )
(RemoveFirstPairs '(40 50 41 7 71 72 71 72 73 10 11 11 210)
(RemovePairs '(-1 102 330 360 5 0 100 101 1 2 3 42 43 51 74 70 280) eLst)
)
(list (cons 1 (cdr (assoc 2 eLst))))
)
)
)

(defun RemoveFirstPairs ( pairs lst )
;; © Lee Mac

(defun foo ( pair lst )
(if lst
(if (eq pair (caar lst))
(cdr lst)
(cons (car lst) (foo pair (cdr lst)))
)
)
)

(foreach pair pairs
(setq lst (foo pair lst))
)
lst
)

(defun RemovePairs ( pairs lst )
;; © Lee Mac
(vl-remove-if
(function
(lambda ( pair )
(vl-position (car pair) pairs)
)
)
lst
)
)
(c:adt)

Advertisements