lisp to explode Attribute definition to text
Hi, i have those texts in the attached file which is can not explode normaly can any one help?
forums.autodesk.com
(defun c:A2t ( / 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
)
)
'autocad' 카테고리의 다른 글
| AutoCAD 빠르게 빠르게 (펌) (0) | 2024.05.07 |
|---|---|
| 모조리 0 레벨로 (2) | 2023.11.23 |
| KMBLOCK.LSP (0) | 2023.09.11 |
| AutoCAD Solid convert to Polyline (0) | 2023.07.13 |
| 현재 ctb (펜세팅) 가져오기 (0) | 2023.06.29 |