타이틀 블록을 깨고 싶습니다.
컨텐츠 정보
- 259 조회
- 2 댓글
- 0 추천
- 0 비추천
-
목록
본문
각종 업체에서 타이틀 블록을 활용한 도면을 받습니다.
관련자료
우남써니타리님의 댓글
구글 검색해서 찾은 속성분해 블록리습이에요.
파일이 첨부가 안되서 파일내용 통째로 붙여놓을게요.
다운만 받고 써보진 않았지만, 잘 되겠죠.
(defun C:BTA ( / *error* doc blocks undo ss ) ;;속성 블록의 문자를 유지하면서 분해하기 (vl-load-com)
(defun *error* ( msg ) (and Undo (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "n** Error: " msg " **"))) (princ) ) (princ "nSelect Block To Explode (Hold Text Attribut) : ") (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) blocks (vla-get-Blocks doc))
(if (ssget "_:L" '((0 . "INSERT"))) (progn (setq Undo (not (vla-StartUndoMark doc))) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc)) (if (eq :vlax-true (vla-get-Explodable (Itemp blocks (BlockName obj)))) (progn ;(alert "Apply") (princ "") );p end (progn ;(alert "Deny") (setq BlockN (BlockName obj) ) (BlkSetExplodability BlockN 1) );p end );if end
(if (eq :vlax-true (vla-get-Explodable (Itemp blocks (BlockName obj)))) (progn (if (eq :vlax-true (vla-get-HasAttributes obj)) (foreach att (vlax-invoke obj 'GetAttributes) (if (eq :vlax-false (vla-get-Invisible att)) ( (if (eq :vlax-false (vla-get-MTextAttribute att)) Att2Text MAtt2MText ) (entget (vlax-vla-object->ename att)) )))) (foreach eobj (vlax-invoke obj 'Explode) (if (eq "AcDbAttributeDefinition" (vla-get-ObjectName eobj)) (vla-delete eobj) )) (vla-delete obj) ))) (vla-Delete ss)
(setq Undo (vla-EndUndomark doc)) ) ) (princ) )
(defun BlockName ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'EffectiveName) 'EffectiveName 'Name ) )) (defun Itemp ( coll item ) (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item) )))) item ))
(defun RemovePairs ( pairs lst ) (vl-remove-if (function (lambda ( pair )(vl-position (car pair) pairs) )) lst ))
(defun RemoveFirstPairs ( pairs lst ) (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 Att2Text ( eLst / dx74 ) (setq dx74 (cdr (assoc 74 eLst))) (entmake (append '( (0 . "TEXT") ) (RemovePairs '(0 100 2 74 70 280) (subst (cons 73 dx74) (assoc 74 eLst) eLst ))))) (defun MAtt2MText ( eLst ) (entmake (append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") ) (RemoveFirstPairs '(40 1 50 41 7 71 72 71 72 73 10 11 11 210) (RemovePairs '(-1 330 5 0 100 101 2 42 43 51 74 70 280) eLst) ))))