[分享]动态圆弧拖拉并显示圆弧半径

ljpnb

我参考晓东CAD里的一个动态直线拖拉显直线长度程序，改成了动态圆弧拖拉并显示圆弧半径，这一功能不一定经常会用到，但也值得参考。 (defun c:ad ()
(setvar "CMDECHO" 0)
(setvar "osmode" 0)
(setq pt1 (getpoint "\n请输入圆弧起点: "))
(setq pt3 (getpoint "\n请输入圆弧第二点: "))
(setq pt2 (cadr (grread T 4 0)))
(setq pt2 (mapcar '+ pt2 '(0.0001 -0.0001)))
(command "Arc" pt1 pt3 pt2) (setq ent (entlast))
(setq arc0 (entget ent))
(setq r0 (rtos (cdr (assoc 40 arc0))))
;;求圆弧新的半径值并转化为字符型
(setq ts1 "R=")
(setq ts2 (strcat ts1 r0 "mm"))
(command "text" pt2 "2.5" "" ts2)
(setq tx1 (entlast))
(vla-put-color (vlax-ename->vla-object tx1) 1)
(setq tx2 (entget tx1))
(setq pick nil)
(while (not pick)
(setq p (grread t 4 0))
(princ)
(setq ip (car p))
(setq pt (cadr p))
(if (= ip 5)
;;;;;;;;;;;;;;确定为坐标移动
(progn
(setq p1 (trans pt 1 0))
;;坐标系转换（以防止更新数据表时出错）
(entdel ent)
;;删除旧的圆弧
(command "arc" pt1 pt3 p1)
(setq ent (entlast))
(setq arc0 (entget ent))
(setq r0 (rtos (cdr (assoc 40 arc0))))
;;求圆弧新的半径值并转化为字符型
(setq ts2 (strcat ts1 r0 "mm"))
(setq tx2 (subst (cons 10 p1) (assoc 10 tx2) tx2))
(setq tx2 (subst (cons 1 ts2) (assoc 1 tx2) tx2))
(entmod tx2)
;;更新文字的位置及内容 )
;;progn
)
;;if
(setq pick (= 3 ip))
;;;确定为点取坐标
)
;;while
(setvar "CMDECHO" 1)
(setvar "osmode" 37);;根据自身的需要可设置成相应的值
;;(entdel ent)
;;(entdel tx1)
;;(print ts2)
(princ)
)

BDYCAD

蛮有创意的. 呵呵. 送朵花花

清风明月名字

谢谢楼主，下载试用了

wzm56209487

谢谢楼主，下载试用看看

技术工作室

又学了一招，顶一个

mokson

这是我想要的功能。