※ <캐드 / 윈도우 종류 및 버전 : 오토캐드2024 / 윈도우10 64비트 >
2024.04.08 픽키님의 텍스트를 지나가는 객체 레이어로 변경하고 싶습니다. 질문에 대하여...
닭발의 소주님이 구현하여 주신 리습은 선과 문자가 같이 있을때
그 문자의 레이어가 선의 레이어를 따라가도록 하는 리습인데...
그 리습을 보고 예전부터 표현하고 싶었던 리습이 있어 도움을 부탁드립니다.
질문하려는 리습은 기본적으로 Lee Mac 에서 제공받은 선 같은 객체를 선택하면...
그 선등의 길이를 나타내려는 객체위에 길이를 표시하여 주는 리습으로서...
그 길이를 나타내는 모든 문자는 해당 선들이 가지고 있는 레이어와 무관하게, 현재로 설정된 레이어로 문자들이 표현됩니다..
이것을 수정하여 선등의 그 길이를 나타내는 문자의 레이어가 해당 선의 레이어를 따라가도록 변경하고 싶습니다.
항상 많은 도움을 주시는 아키모아 카페 회원님들께 언제나 감사의 마음을 드립니다.
원래의 리습은 아래와 같습니다.
;;----------------------=={ Length at Midpoint }==----------------------;;
(defun c:midlen_1 ( / *error* ent fmt idx ins ocs par sel spc txt typ uxa )
(setq fmt "%lu2%pr1%ct8[0.001]") ;; Field Formatting
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
);defun *error* ( msg )
(if
(setq sel (ssget (list
'(0 . "ARC,CIRCLE,LINE,*POLYLINE")
'(-4 . "<NOT")
'(-4 . "<AND")
'(0 . "POLYLINE")
'(-4 . "&")
'(70 . 80)
'(-4 . "AND>")
'(-4 . "NOT>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(progn
(setq spc
(vlax-get-property (LM:acdoc)
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
);vlax-get-property (LM:acdoc)
)
(setq ocs (trans '(0.0 0.0 1.0) 1 0 t)
uxa (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 ocs t))
)
(LM:startundo (LM:acdoc))
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
par (vlax-curve-getparamatdist ent (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2.0))
ins (vlax-curve-getpointatparam ent par)
typ (cdr (assoc 0 (entget ent)))
)
(setq txt
(vlax-invoke spc 'addmtext ins 0.0
(strcat
"%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%)."
(cond
( (= "CIRCLE" typ) "Circumference")
( (= "ARC" typ) "ArcLength")
( "Length" )
)
">%" "+ 45.0000)"
" \\f \"" fmt "\">%"
)
)
)
(vla-put-backgroundfill txt :vlax-true)
(vla-put-attachmentpoint txt acattachmentpointmiddlecenter)
(vla-put-insertionpoint txt (vlax-3D-point ins))
(vla-put-rotation txt (LM:readable (- (angle '(0.0 0.0 0.0) (trans (vlax-curve-getfirstderiv ent par) 0 ocs t)) uxa)))
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; Readable - Lee Mac
;; Returns an angle corrected for text readability.
(defun LM:readable ( a )
( (lambda ( a )
(if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
(LM:readable (+ a pi))
a
)
)
(rem (+ a pi pi) (+ pi pi))
)
)
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:objectid ( obj )
(eval
(list 'defun 'LM:objectid '( obj )
(if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(LM:ename->objectid (vlax-vla-object->ename obj))
)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:objectid obj)
)
;; Entity Name to ObjectID - Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name
(defun LM:ename->objectid ( ent )
(LM:hex->decstr
(setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
ent (substr ent (+ (vl-string-position 58 ent) 3))
)
)
)
;; Hex to Decimal String - Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string
(defun LM:hex->decstr ( hex / foo bar )
(defun foo ( lst rtn )
(if lst
(foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
(apply 'strcat (mapcar 'itoa (reverse rtn)))
)
)
(defun bar ( int lst )
(if lst
(if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
(cons (rem int 10) (bar (/ int 10) (cdr lst)))
)
(bar int '(0))
)
)
(foo (vl-string->list (strcase hex)) nil)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
첫댓글 리습 64번줄에 추가 해보세요.............(vla-put-layer txt (vla-get-layer (vlax-ename->vla-object ent)))
와~ 지금 실행해봤습니다. 정말 너무 잘 됩니다.
주왕님 넘 감사합니다.
실례가 안된다면 한번만 더 문의 하겠습니다.
현재는 text의 레이어가 line의 레이어를 따라가도록 되어 있는데 line 레이어에 접두어 또는 접미어를 붙인 레이어 이름을 추가로 만들수 있나요??
예를 들어 line 이 급수라는 레이어라면 문자는 급수_dist라는 레이어 이름으로 문자가 생성되었으면 합니다.
한번에 문의가 끝나야 하는데...
원하던 리습이 구현되다 보니 좀 더 변형된 리습에 욕심이 생기나 봅니다...
불금에 좋은 주말 보내세요..
레이어 이름 변경은 검색하시면 있을텐데요...........
대가리가 딱딱해지는 나이인지라 만드는건 고수분들께........ 패스
포털 및 구글링으로 검색해봐도 원하는 비슷한 유형의 정보를 못 찾겠네요..
그래도 주왕님이 알려주신 구문을 추가해서 사용하는것만으로 많음 도움이 되었습니다.
좋은 내용 감사드립니다.