模拟电缆裕度弯拉伸效果动画

yjwht

看了xyp1964的点评：中间状态应尽可能用grread函数点集模拟曲线状态，避免不停的生成和删除多段线
代码修改成这样了，我也只会这一点了，避免不停的生成和删除多段线却是做不到：

1. (defun c:tt  (/ R L1  Lt H a1  p1 p2  p3 p4  p6 p7
   
2.              p8 p9  p10 Lx L0  L2 n keylist)
   
3.   (setq R 1900)                          ;设置弯曲半径（mm）
   
4.   (setq L1 1000)                        ;设置直线段初始长度（mm）
   
5.   (setq Lt (+ (* 2 L1) (* 2 pi R)))
   
6.   (setq  p1 '(0 0)
   
7.         p2 (list L1 0)
   
8.         p3 (list 1000 R)
   
9.   )
   
10.   (setq H (* R 2))
    
11.   (tt2)
    
12.   (princ "\n调整拱高 a小减，d小增 ，s大减 ，w大增：")
    
13.   (terpri)
    
14.   (setq keylist '(119 115 97 100))
    
15.   (setq n (cadr (grread)))
    
16.   
    
17.   (while (/= n 13)
    
18.     (grtext -1 "按 a(-10) d(+10) s(-100) w(+100)")
    
19.     (while (not (member n keylist))
    
20.       (setq n (cadr (grread)))
    
21.     )
    
22.     (cond
    
23.          ((equal n 97) (setq H (max 0 (- H 10))))  ; a
    
24.          ((equal n 100) (setq H (min 3800 (+ H 10))))  ; d
    
25.          ((equal n 115) (setq H (max 0 (- H 100)))) ; s
    
26.          ((equal n 119) (setq H (min 3800 (+ H 100))))  ; w
    
27.     )
    
28.     (entdel (entlast))
    
29.     (tt2)
    
30.     (setq n (cadr (grread)))
    
31.   )
    
32.   (princ)
    
33. )
    
34. 
    
35. (defun tt2 ()
    
36.   (setq a1 (atan (- (* R 2) H) (sqrt (- (* R H 4) (* H H)))))
    
37.   (setq p4 (polar p3 (* a1 -1) R))
    
38.   (setq p6 (polar p3 (* a1 -1) (* R 2)))
    
39.   (setq p7 (polar p6 a1 R))
    
40.   (setq p8 (polar p6 a1 (* R 2)))
    
41.   (setq p9 (polar p8 (* pi -0.5) R))
    
42.   (setq Lx (- Lt (* pi R 2) (* a1 R -4) L1))
    
43.   (setq p10 (polar p9 0 Lx))
    
44.   (command "PLINE" p1  "W"  95 95  p2 "A" "CE"  p3 p4  p7 "CE"  p8 p9  "L"  p10
    
45.            "")
    
46.   (setq L0 (- (* pi R 2) (* a1 R 4) (distance p2 p9))) ;剩余预留长度
    
47.   (setq L2 (- (* pi R 2) (* R 4) L0))
    
48.   (princ (strcat "\n拱高" (rtos H 2 0) "mm    "))
    
49.   (princ (strcat "剩余预留长度" (rtos L0 2 0) "mm    "))
    
50.   (princ (strcat "已拉伸长度" (rtos L2 2 0) "mm"))
    
51. )

(defun c:tt  (/ R L1  Lt H a1  p1 p2  p3 p4  p6 p7</font></font><br />              p8 p9  p10 Lx L0  L2 n keylist)<br />   (setq R 1900)                          ;设置弯曲半径（mm）<br />   (setq L1 1000)                        ;设置直线段初始长度（mm）<br />   (setq Lt (+ (* 2 L1) (* 2 pi R)))<br />   (setq  p1 '(0 0)<br />         p2 (list L1 0)<br />         p3 (list 1000 R)<br />   )<br />   (setq H (* R 2))<br />   (tt2)<br />   (princ "\n调整拱高 a小减，d小增 ，s大减 ，w大增：")<br />   (terpri)<br />   (setq keylist '(119 115 97 100))<br />   (setq n (cadr (grread)))<br />   <br />   (while (/= n 13)<br />     (grtext -1 "按 a(-10) d(+10) s(-100) w(+100)")<br />     (while (not (member n keylist))<br />       (setq n (cadr (grread)))<br />     )<br />     (cond<br />          ((equal n 97) (setq H (max 0 (- H 10))))  ; a<br />          ((equal n 100) (setq H (min 3800 (+ H 10))))  ; d<br />          ((equal n 115) (setq H (max 0 (- H 100)))) ; s<br />          ((equal n 119) (setq H (min 3800 (+ H 100))))  ; w<br />     )<br />     (entdel (entlast))<br />     (tt2)<br />     (setq n (cadr (grread)))<br />   )<br />   (princ)<br /> )<br /> <br /> (defun tt2 ()<br />   (setq a1 (atan (- (* R 2) H) (sqrt (- (* R H 4) (* H H)))))<br />   (setq p4 (polar p3 (* a1 -1) R))<br />   (setq p6 (polar p3 (* a1 -1) (* R 2)))<br />   (setq p7 (polar p6 a1 R))<br />   (setq p8 (polar p6 a1 (* R 2)))<br />   (setq p9 (polar p8 (* pi -0.5) R))<br />   (setq Lx (- Lt (* pi R 2) (* a1 R -4) L1))<br />   (setq p10 (polar p9 0 Lx))<br />   (command "PLINE" p1  "W"  95 95  p2 "A" "CE"  p3 p4  p7 "CE"  p8 p9  "L"  p10<br />            "")<br />   (setq L0 (- (* pi R 2) (* a1 R 4) (distance p2 p9))) ;剩余预留长度<br />   (setq L2 (- (* pi R 2) (* R 4) L0))<br />   (princ (strcat "\n拱高" (rtos H 2 0) "mm    "))<br />   (princ (strcat "剩余预留长度" (rtos L0 2 0) "mm    "))<br />   (princ (strcat "已拉伸长度" (rtos L2 2 0) "mm"))<br /> )