再向你求一个autolisp程序,
来源:学生作业帮 编辑:作业帮 分类:数学作业 时间:2024/11/08 11:19:21
再向你求一个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).
要求:选择一条直线,得到它的长度(如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).
(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测试下吧
再问: 由于文字位置放置达不到要求,需要两个程序:我先选择数字文字,然后输入你的命令,你的程序在不改变文字位置及方向的情况下,得到我想要的结果,就是上面提到的格式(7500-4-180);文字位置我可以用动作录制器来实现。及用动作录制器得到数字文字。我已经得到数字文字了,那么框选这些数字文字,在不改变文字大小及方向的情况下,直接得到我想要的结果。(如果文字已经修改,那么不改变文字)
再答: 字数限制,我修改过的程序没法发到这里来,私信给你吧
功能包括
1,转换所有符合的文字对象;
2,转换框选中的符合的文字对象;
3,转换框选中的包含输入数值的文字对象;
4,转换框选中的包含选择文字的数值的文字对象;
(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测试下吧
再问: 由于文字位置放置达不到要求,需要两个程序:我先选择数字文字,然后输入你的命令,你的程序在不改变文字位置及方向的情况下,得到我想要的结果,就是上面提到的格式(7500-4-180);文字位置我可以用动作录制器来实现。及用动作录制器得到数字文字。我已经得到数字文字了,那么框选这些数字文字,在不改变文字大小及方向的情况下,直接得到我想要的结果。(如果文字已经修改,那么不改变文字)
再答: 字数限制,我修改过的程序没法发到这里来,私信给你吧
功能包括
1,转换所有符合的文字对象;
2,转换框选中的符合的文字对象;
3,转换框选中的包含输入数值的文字对象;
4,转换框选中的包含选择文字的数值的文字对象;
求助Autolisp:定义一个求三角形面积的函数.
【AutoLISP】请教:下面这两句语言是一个程序里的两句,
autolisp中画两圆公切线的程序怎么写?
autolisp问题自己编了一个小程序,然后再添加到了cad菜单栏中,但是重启cad,然后使用新添加的菜单栏中的程序的时
autolisp教程 请高手用AutoLISP编写4个小程序:
请看一下下面的AUTOLISP 程序有什么错误
编写autolisp程序并通过visual lisp集成开发环境调试该程序
求一个Fortran程序
求编写一个matlab程序
autolisp画平面图形,程序如图,想画左边的图形,按照我的程序却出来右边这个图形,大神看看我的程序
AutoLisp画同心圆
求大神帮忙写一个java程序