(defun $vp->lp ( opt / )
(if (= (type opt) 'variant) (Vlax-SafeArray->List (Vlax-Variant-Value opt)) (Vlax-3d-Point opt) )
)
(if (null vlax-dump-object) (vl-load-com) )
(setq &mod (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(if (setq &sel (entsel "\n請選擇要標示的直線:"))
(if (= (vla-get-objectname (setq @ps (cadr &sel) &sel (vlax-ename->vla-object (car &sel)))) "AcDbLine")
(progn
(setq @p1 ($vp->lp (vla-get-startpoint &sel)) @p2 ($vp->lp (vla-get-endpoint &sel)))
(setq @pv (vl-sort (list @p1 @p2) (function (lambda (a b) (< (distance a @ps) (distance b @ps))))))
(setq @p1 (car @pv) @p2 (cadr @pv) #an (rem (angle @p1 @p2) pi))
(setq @p3 (polar (polar @p1 #an 550) (+ #an (/ pi 2)) 50))
(if (> (setq #ds (read (rtos (vla-get-length &sel) 2 0))) 3660)
(setq %tx (strcat (itoa #ds) "-" (itoa (/ #ds 1830)) "-" (itoa (rem #ds 1830))))
(setq %tx (itoa #ds))
)
(setq &tx (vla-addtext &mod %tx ($vp->lp @p3) 300))
(vla-put-stylename &tx "HzTxt") (vla-put-layer &tx "a001")
(vla-getboundingbox &tx 'p1 'p2) (setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
(setq #tw (- (car p2) (car p1)) #th (- (cadr p2) (cadr p1))) (vla-put-rotation &tx #an)
(if (or (> (distance @p3 @p1) #ds) (> (distance @p3 @p2) #ds)) (setq @p3 (polar @p3 #an (- 0 #tw 1100))) )
(vla-put-insertionpoint &tx ($vp->lp @p3))
(initget "C") (setq #kw (getkword "\n是否需要鏡像位置?[鏡像(C)]: <不鏡像> "))
(if (member #kw (list "C" "c"))
(progn
(setq @pn (vlax-curve-getclosestpointto &sel @p3) @p3 (polar @pn (angle @p3 @pn) (+ #th 50)))
(vla-put-insertionpoint &tx ($vp->lp @p3))
)
)
(princ "\n標示直線成功!")
)
(princ "\n選擇的不是直線對象!")
)
(princ "\n未選擇對象!")
)
(princ)
)
程序總算寫出來了，主要是文字位置的擺放費了不少時間去解決，命令tes測試下吧