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

ljpnb

我参考本论坛里的一个动态直线拖拉显直线长度程序，改成了动态圆弧拖拉并显示圆弧半径，这一功能不一定经常会用到，但程序的思路值得参考。

(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)
)

whiteon

直接来个现成的发给大家得了！

ljpnb

大家给点意见嘛！

xyp1964

标注的半径数值应该从圆心指向弧线的中点，并属于 DIMENSION 实体。

aeo

圆弧半径不就是距离吗:下面显示坐标的地方有.

zh_6531394

1楼楼主
"命令: ad

请输入圆弧起点:
请输入圆弧第二点: *无效*

Error: 函数被取消."
请问什么原因