[源码] (ACR)圆心、半径、起始角度和终止角度画弧

admin

1. ;;;圆心、半径、起始角度和终止角度画弧  
2. ;;;2024.6.21 动态显示
3. (defun c:acr(/ *error* arcdata carc cen dxf50 dxf51 ea gr olderr pt r sa)
4.   (setq olderr *error*)
5.   (defun *error*(msg) (entdel carc) (princ "\n程序强制已退出！") (princ))
6.   (while (/= (type (setq cen (getpoint "\n指定圆弧的圆心[ESC退出]："))) 'LIST))
7.   (while (/= (type (setq r (getdist cen "\n指定圆弧的半径[ESC退出]: "))) 'REAL))
8.   (while (/= (type (setq sa (getangle cen "\n指定圆弧起始角度[ESC退出]："))) 'REAL))
9.   (setq carc (entmakex (list '(0 . "ARC") (cons 10 cen) (cons 40 r) (cons 50 sa) (cons 51 sa))) arcdata (entget carc))
10.   (prompt "\n指定圆弧终止角度[ESC退出]：")
11.   (while (or (and (setq gr (grread T 15 0)) (= (car gr) 5)) (or (= (car gr) 2) (= (car gr) 11) (= (car gr) 12) (= (car gr) 25)))
12.     (if (= (car gr) 5)
13.       (progn
14.         (setq ea (angle cen (cadr gr)))
15.         (setq arcdata (subst (cons 51 ea) (assoc 51 arcdata) arcdata))
16.         (entmod arcdata)
17.       )
18.     )
19.   )
20.   (prompt "\n请使用【空格】改变圆弧方向,左键单击完成！")
21.   (while (or (and (setq gr (grread T 15 0)) (= (car gr) 5)) (or (= (car gr) 2) (= (car gr) 11) (= (car gr) 12) (= (car gr) 25)))
22.     (if (equal gr '(2 32))
23.       (progn
24.         (setq dxf50 (cons 50 (cdr (assoc 51 arcdata))) dxf51 (cons 51 (cdr (assoc 50 arcdata))))
25.         (setq arcdata (subst dxf50 (assoc 50 arcdata) arcdata))
26.         (setq arcdata (subst dxf51 (assoc 51 arcdata) arcdata))
27.         (entmod arcdata)
28.       )
29.     )
30.   )
31.   (prin1)
32. )

复制代码