两点动态圆弧------(一级)-----

admin

1. ;;两点动态圆弧------(一级)-----
3. ;功能：给2点画弧，且提示弧长，半径，并支持扑捉，TAB键乒乓开关信息
4. (defun 2p-dd-arc (p1 p2 / p3 nam nam1 obj nam2 ent ent1 loop bb pt f3 d ang s0 s s1 s2 s3)
5.   (command "_.undo" "be")
6.   (setq s0 "\n->动态圆弧 [信息开关(TAB)/扑捉(F3)/定位(Left-Right-Other keys)]")
7.   (setq p3 (polar (sl:mid p1 p2) (+ (angle p1 p2) pi2) 50) s1 "mm" s2 "..开.." s3 "..关..")
8.   (make-arc p1 p3 p2) ;3P画弧
9.   (setq nam (entlast))
10.   (slmkwz (strcat "R=" (rtos (* (getvar "DIMLFAC") (dxf1 nam 40))) s1) p3 3.0 0 nil "f-i-n-d" nil 6 "m") ;中心定位写字
11.   (setq ent (entget (setq nam1 (entlast))) obj (en2obj nam1))
12.   (slmkwz (strcat "L=" (rtos (* (getvar "DIMLFAC") (sllen nam))) s1) p3 3.0 0 nil "f-i-n-d" nil 6 "m")
13.   (setq ent1 (entget (setq nam2 (entlast))))
14.   (setq loop t f3 (getvar "OSMODE") s s2)
15.   (princ (strcat s0 "(" s ")"))
16.   (while loop
17.     (setq bb (grread t 15 2))
18.     (setq pt (cadr bb) d (p2uu 20))
19.     (cond
20.       ((equal bb '(2 6));F3切换捕捉开关
21.         (cond
22.           ((and (< f3 16384) (/= f3 0))
23.             (setq f3 (+ f3 16384))
24.             (prompt "\n <对象捕捉 关>")
25.           )
26.           ((or (= f3 0) (>= f3 16384))
27.             (setq f3 16383)
28.             (prompt "\n <对象捕捉 开>")
29.           )
30.         )
31.         (setvar "OSMODE" f3)(redraw)
32.       )   
33.       ((= (car bb) 5)
34.         (redraw)
35.         (if (and (<= f3 16384) (> f3 0))
36.           (setq pt (slosnappt nam pt))
37.         )
38.         (setq pt (trans pt 1 0))
39.         (entdel nam)
40.         (make-arc p1 pt p2)
41.         (setq nam (entlast))
42.         (if (= s s2)
43.           (progn
44.             (setq ang (angle-sharp (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv nam (vlax-curve-getparamatpoint nam pt)))))
45.             (setq pt (polar pt (+ ang pi2) (* 0.7 d)))
46.             (entmod (emod (emod (emod (emod (emod ent 1 (strcat "R=" (rtos (* (getvar "DIMLFAC") (dxf1 nam 40))) s1)) 10 pt) 11 pt) 40 d) 50 ang))
47.             (setq pt (polar pt (+ ang pi2) (* 1.3 d)))
48.             (entmod (emod (emod (emod (emod (emod ent1 1 (strcat "L=" (rtos (* (getvar "DIMLFAC") (sllen nam))) s1)) 10 pt) 11 pt) 40 d) 50 ang))
49.           )
50.         )
51.       )
52.       ((member bb '((2 9))) ;;table 信息关
53.         (entdel nam1) (entdel nam2)
54.         (if (not (vlax-erased-p obj)) (setq s s2) (setq s s3))
55.         (princ (strcat s0 "(" s ")"))
56.       )
57.       ((or t (equal (car bb) 3) (member (car bb) '(11 25)));;左、右、其余键
58.         (setq loop nil)
59.       )
60.     )
61.   )
62.   (command "_.undo" "e")
63.   (redraw)
64. )
65. ;;测试-----(需要三领支持测试)
66. (defun c:tt (/ p1 p2)
67.   (setq p1 (getpoint "\n 圆弧第一点:")
68.     p2 (getpoint p1 "\n 圆弧第二点:")
69.   )
70.   (2p-dd-arc p1 p2)
71. )

复制代码