80 lines
1.7 KiB
Common Lisp
80 lines
1.7 KiB
Common Lisp
;AttDef2Text: Attribute definitions to txt by Lee Mac. source: https://www.cadtutor.net/forum/topic/21700-convert-attribute-definition-to-text/
|
|
(defun c:AttDef2Text ( / ss )
|
|
;; © Lee Mac ~ 01.06.10
|
|
(vl-load-com)
|
|
(if (setq ss (ssget "_A" '((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
|
|
)
|
|
) |