再向你求一个autolisp程序,要求:选择一条直线,得到它的长度(如7500),那么在沿直线方向标上文字如(7500-4-180),这个文字高度为300,距离直线50,离直线的端点为550,字体为HzTxt(字体样式Text)
来源:学生作业帮助网 编辑:六六作业网 时间:2024/11/21 22:44:52
再向你求一个autolisp程序,要求:选择一条直线,得到它的长度(如7500),那么在沿直线方向标上文字如(7500-4-180),这个文字高度为300,距离直线50,离直线的端点为550,字体为HzTxt(字体样式Text)
再向你求一个autolisp程序,
要求:选择一条直线,得到它的长度(如7500),那么在沿直线方向标上文字如(7500-4-180),这个文字高度为300,距离直线50,离直线的端点为550,字体为HzTxt(字体样式Text),文字选择图层为(a001).
长度为整数(小数点后四舍五入),数据为(7500-4×1830=180),7500为长度,1830数据不变,得到的数值要大于0,小于1830.7500-4-180表示:7500长度,4个1830,余数为180;同理6310-3-820表示为长度6310,3个1830,余数为820;
只要长度小于1830×2=3660,那么文字只要表达长度即可如(3659).
再向你求一个autolisp程序,要求:选择一条直线,得到它的长度(如7500),那么在沿直线方向标上文字如(7500-4-180),这个文字高度为300,距离直线50,离直线的端点为550,字体为HzTxt(字体样式Text)
(defun c:tes ( / &mod &sel @ps @pv #ds @p1 @p2 #an %tx &rc p1 p2 #tw #th #kw @pn )
(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测试下吧