성심 성의껏 질문을 작성하여 주세요, 대충하시면 답변도 대충작성합니다.^^
- 제목 작성시 금지어
만들어주세요? 해주세요? 안되는데 이렇게 변경해주세요? 등등
- 특정분과 질문은 제목에 분과삽입 [건축]
좋은예) [분과]무엇에 대해 문의합니다. /[분과]B로 바꾸는 방법을 알고싶습니다.
- 말머리 필수
① CAD 종류 : 오토캐드
② VERSION : 2012
③ 운영 체제 : 윈도우 xp
;//////////////////////////////////////////////////////////////////////////////////////////////////////////
;;; 타이틀 문자 정렬시키기 (Create by MrLISP 달수 2012.03.28)
;//////////////////////////////////////////////////////////////////////////////////////////////////////////
(defun c:T1 (/ acDoc MrSta MrEnd foo3 sort ss oName lineLst circleLst textLst lObj xy p1 p2 pm tLst
tObjLst doTextObj upTextObj tPm mi mx tP2)
(vl-load-com)
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
(defun *error* (msg)(MrEnd)
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n** Error: " msg " **")))(princ)
)
(defun MrSta (/ lst o)(MrEnd)
(setq gv (mapcar 'getvar (setq gvL '("OSMODE" "CMDECHO"))))
(mapcar 'setvar gvL '(0 0))(vla-startundomark acDoc)
)
(defun MrEnd ()
(if (and gvL gv)(mapcar 'setvar gvL gv))
(if (= 8 (logand 8 (getvar 'UNDOCTL)))(vla-endundomark acDoc))
)
(defun foo3 (lst) (if lst (cons (list (car lst)(cadr lst)(caddr lst))(foo3 (cdddr lst)))))
(defun sort (lst f)(vl-sort lst (function (lambda (x1 x2)(f (car x1) (car x2))))))
(setq ss (ssget '((0 . "line,text,circle"))))
(foreach obj
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
(setq oName (vla-get-ObjectName obj))
(cond
((= oName "AcDbLine")(setq lineLst (cons obj lineLst)))
((= oName "AcDbCircle")(setq circleLst (cons obj circleLst)))
((= oName "AcDbText")(setq textLst (cons obj textLst)))
)
)
(and
lineLst
(setq lObj (cadar (sort (mapcar '(lambda (x)(list (vla-get-Length x) x)) lineLst) >)))
(setq p2 (cadr (sort (list (vlax-curve-getStartPoint lObj)(vlax-curve-getEndPoint lObj)) <)))
)
(if (and circleLst lObj)
(if (setq xy (vlax-invoke lObj 'intersectwith (car circleLst) 0))
(setq p1 (car (sort (foo3 xy) >)))
(setq p1 (car (sort (list (vlax-curve-getStartPoint lObj)(vlax-curve-getEndPoint lObj)) <)))
)
(and
lineLst
(setq p1 (car (sort (list (vlax-curve-getStartPoint lObj)(vlax-curve-getEndPoint lObj)) <)))
)
)
(and p1 p2 (setq pm (mapcar '* '(0.5 0.5 0.5)(mapcar '+ p1 p2))))
(and pm (> (length textLst) 1)
(setq tLst
(mapcar 'cdr
(sort
(mapcar
'(lambda (x)(setq iP (vlax-get x 'InsertionPoint))
(list (distance pm iP) iP x)
)
textLst
)
<
)
)
)
(setq tObjLst (vl-sort (list (car tLst)(cadr tLst))(function (lambda (x1 x2)(< (cadar x1) (cadar x2))))))
(setq doTextObj (cadar tObjLst) upTextObj (cadadr tObjLst))
)
(MrSta)
(if (and pm doTextObj upTextObj)
(progn
(setq tPm (vlax-3d-point (list (car pm)(cadar (cadr tObjLst)) 0.0)))
(vla-put-Alignment upTextObj 1)
(vla-put-TextAlignmentPoint upTextObj tPm)
(vla-getboundingbox upTextObj 'mi 'mx)
(setq mx (vlax-safearray->list mx))
(setq tP2 (vlax-3d-point (list (car mx)(cadar (car tObjLst)) 0.0)))
(vla-put-Alignment doTextObj 2)
(vla-put-TextAlignmentPoint doTextObj tP2)
)
)(MrEnd)(princ)
)(princ "[명령어 : T1 ]")(princ)
타이틀 문자 정렬시키기 리습이랍니다
첨부파일에 내용이 있는데 가능한지 궁금합니다 ..
Drawing1.dwg
※ 유의사항
- ①말머리 : 말머리를 달아야 구분이 쉽겠죠^^
- ②Screenshot : 이해를 돕기위해 삽입요망.
- ③파일 첨부 : 상위버전에서 테스트할 파일이 아니면 가급적 하위버전으로 저장후 첨부.
해당리습/해당파일(DWG) 도 같이 첨부하여 주세요.
- ④제 목 : 질문 내용 반영(개략적인 내용), 예) 해치를 만들고 싶어요, pline을 연결할려면?
- ⑤질문글 삭제금지 : 질문후 댓글이 달린글은 삭제금지.
여러 리플러들이 소중한 시간을 내어서 고민한후 댓글을 작성한 이상 "강력조치" 토록 하겠음.
※ 정답만이 댓글은 아닙니다. 그 답이 맞던 틀리던 그건 그 댓글로서 존중되어야 합니다.
회원님들이 글을 읽었다는것과 댓글을 달았다는건 그만큼 관심을 가지고 있고 또 그 답을 해주기 위해
검색도 해보고 도움말도 보고 고민도 하는 일련의 과정을 거치면서 나오기 때문이죠.
이에 대한 고마움과 감사함을 모르는 테러행위(?)는 없었으면 합니다.
