你好各位大神帮我修改一下这个代码我要在CAD2025上运行谢谢
你好各位大神帮我修改一下这个代码我要在CAD2025上运行谢谢你好各位大神帮我修改一下这个代码正常我在画多段线输入50多段线上就出现个50标注，现在是输入50他出现359.0197801584798麻烦各位大神帮帮忙修改输入多少数字就出现多少数字好比输入50就出现50。
(defun c:tg(/p1 p2 p3 p4 pt dd)
(command ".undo" "be")
(setq p1(getpoint "\n指定点"))
(command ".CIRCLE" "non" p1 3)
(while
(setq p2(getpoint p1 "\n指定点")
p3(polar p1 (angle p1 p2) 3)
p4(polar p2 (angle p2 p1) 3)
)
(command ".line" "non" p3 "non" p4 "")
(setq dd (distance p1 p2)
pt (polar p2 (angle p2 p1) (+ (* dd 0.55) 1.5)))
(command ".CIRCLE" "non" p2 3)
(command ".text" "non" pt 6 (/ (* (angle p1 p2) 180.0) pi) (rtos dd 2 2)"")
(setq p1 p2)
)
(command ".undo" "e")
(princ)
)
这是第二个代码也是这种情况麻烦也帮我修改一下谢谢：
(defun c:t2t ( /p1 p2 p3 p4 pt dd)
(command ".undo" "be")
(setq rad (getdist"\n指定半径: "))
(setq p1 (getpoint "\n指定圆心: "))
(while
(setq p2 (getpoint p1 "\n指定点") )
(command ".line" "non" p1 "non" p2 "")
(setq dd (distance p1 p2)
pt (polar p2 (angle p2 p1)(* dd 0.5)))
(setq p3 (polar pt (atan (/ (* (angle p1 p2) 180.0) pi)) 0.6))
(LM:CircularWipeout p1 rad)
(command ".text" "j" "c" "non" p3 6 (/ (* (angle p1 p2) 180.0) pi) (rtos dd 2 2)"")
(setq p1 p2)
)
(command ".undo" "e")
(princ)
)
(defun LM:CircularWipeout ( cen rad / ang inc lst )
(setq acc 50 inc (/ pi acc 0.5) ang 0.0)
(repeat acc(setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst)ang (+ ang inc)))
(entmakex(append(list '(000 . "WIPEOUT")'(100 . "AcDbEntity")'(100 . "AcDbWipeout")
(cons 10 (trans (mapcar '- cen (list rad rad)) 1 0))(cons 11 (trans (list (+ rad rad) 0.0) 1 0 t))
(cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t))'(280 . 1)'(071 . 2))(cons (last lst) lst))))
(princ)
在CAD2024上好用在CAD2025上就不好用麻烦各位大神谢谢
2025可能是重新了有些命令的参数，我这也是有几个LSP文件在2020-2024可以正常使用，但是2025就不行了。不知道具体是什么原因，坐等大佬们给个解决方案:lol (defun entmakecircle(pt rad)(entmakex (list '(0 . "circle") (cons 10 pt) (cons 40 rad))))
(defun entmakeline(p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))
(defun entmaketext(pt str h ang)(entmakex (list '(0 . "TEXT") (cons 10 pt)(cons 11 pt)(cons 73 0)(cons 72 1) (cons 1 str) (cons 40 h)(cons 50 ang))))
(vl-load-com)
(defun c:tg(/ p1 p2 p3 p4 pt dd ang)
(if(setq p1(getpoint "\n指定起点: "))
(progn
(vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
(entmakecircle p1 3)
(while(setq p2(getpoint p1 "\n指定下一点(空格退出): "))
(setq p3(polar p1 (angle p1 p2) 3)
p4(polar p2 (angle p2 p1) 3)
)
;;文字中点
(setq pt(mapcar '(lambda(x y)(*(+ x y) 0.5)) p1 p2))
(setq dd(distance p1 p2))
(entmakeline p3 p4)
(entmakecircle p2 3)
(setq ang (angle p1 p2))
;;文字正向
(if(and (> ang (* pi 0.5)) (< ang(* pi 1.5)))(setq ang (angle p2 p1)))
;;文字偏移
(setq pt (polar pt (+ ang (* 0.5 pi)) 0.625))
;;生成文字
(entmaketext pt (rtos dd 2 2) 6 ang)
(setq p1 p2)
)
(vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
)
)
(princ)
) edata 发表于 2024-8-5 14:26
赞一个，确实比command要beautiful 本帖最后由 万事如意 于 2024-8-5 16:32 编辑
edata 发表于 2024-8-5 14:26
你好大神我在CAD2025里以前图纸里用输入米数就出问题我在CAD里新建一个空间就好了你好大神我是不是CAD哪个地方设置不对你帮我看一下我的这个图纸在麻烦大神能把数字离开多段线1mm距离谢谢你。
万事如意 发表于 2024-8-5 16:19
你好大神我在CAD2025里以前图纸里用输入米数就出问题我在CAD里新建一个空间就好了你好大神我是不是CAD哪 ...
复现不了你的问题. 文字偏移改0.625为 1 即可 (setq pt (polar pt (+ ang (* 0.5 pi)) 1)) 2025还没有用啊。
edata 发表于 2024-8-5 17:16
复现不了你的问题. 文字偏移改0.625为 1 即可 (setq pt (polar pt (+ ang (* 0.5 pi)) 1))
你好大神能把标注数字离开多段线1-2mm距离谢谢你。
我用你这个改了文字偏移改0.625为 1 即可 (setq pt (polar pt (+ ang (* 0.5 pi)) 1))标注的文字还紧贴多段线。http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTM2NDM3fGEzYzZiOTUxfDE3MjI5MDE2OTd8NzMzMTcyOHwxOTA4NTg%3D&noupdate=yes 还是无法复现你的问题.
页:
[1]