[Lisp] 선 중간에 길이를 표시하는 문자를 해당 선의 레이어와 같은 레이어로 구현하고 싶습니다.

[스르르르]

※   <캐드 / 윈도우 종류 및 버전 :   오토캐드2024  /  윈도우10 64비트    >

2024.04.08 픽키님의 텍스트를 지나가는 객체 레이어로 변경하고 싶습니다. 질문에 대하여...

닭발의 소주님이 구현하여 주신 리습은 선과 문자가 같이 있을때

그 문자의 레이어가 선의 레이어를 따라가도록 하는 리습인데...

그 리습을 보고 예전부터 표현하고 싶었던 리습이 있어 도움을 부탁드립니다.

질문하려는 리습은 기본적으로 Lee Mac 에서 제공받은 선 같은 객체를 선택하면...

그 선등의 길이를 나타내려는 객체위에 길이를 표시하여 주는 리습으로서...

그 길이를 나타내는 모든 문자는 해당 선들이 가지고 있는 레이어와 무관하게, 현재로 설정된 레이어로 문자들이 표현됩니다..

이것을 수정하여 선등의 그 길이를 나타내는 문자의 레이어가 해당 선의 레이어를 따라가도록 변경하고 싶습니다.

항상 많은 도움을 주시는 아키모아 카페 회원님들께 언제나 감사의 마음을 드립니다.

원래의 리습은 아래와 같습니다.

MidLen_1.lsp

4.71KB

;;----------------------=={ 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라는 레이어 이름으로 문자가 생성되었으면 합니다.
한번에 문의가 끝나야 하는데...
원하던 리습이 구현되다 보니 좀 더 변형된 리습에 욕심이 생기나 봅니다...

불금에 좋은 주말 보내세요..

[주왕]

레이어 이름 변경은 검색하시면 있을텐데요...........
대가리가 딱딱해지는 나이인지라 만드는건 고수분들께........ 패스

[스르르르]

포털 및 구글링으로 검색해봐도 원하는 비슷한 유형의 정보를 못 찾겠네요..
그래도 주왕님이 알려주신 구문을 추가해서 사용하는것만으로 많음 도움이 되었습니다.

[AUTOLISP가자]

좋은 내용 감사드립니다.