代码修改成这样了，我也只会这一点了，避免不停的生成和删除多段线却是做不到：
(defun c:tt(/ R L1Lt H a1p1 p2p3 p4p6 p7
p8 p9p10 Lx L0L2 n keylist)
(setq R 1900) ;设置弯曲半径（mm）
(setq L1 1000) ;设置直线段初始长度（mm）
(setq Lt (+ (* 2 L1) (* 2 pi R)))
(setqp1 '(0 0)
p2 (list L1 0)
p3 (list 1000 R)
)
(setq H (* R 2))
(tt2)
(princ "\n调整拱高 a小减，d小增 ，s大减 ，w大增：")
(terpri)
(setq keylist '(119 115 97 100))
(setq n (cadr (grread)))
(while (/= n 13)
(grtext -1 "按 a(-10) d(+10) s(-100) w(+100)")
(while (not (member n keylist))
(setq n (cadr (grread)))
)
(cond
((equal n 97) (setq H (max 0 (- H 10)))); a
((equal n 100) (setq H (min 3800 (+ H 10)))); d
((equal n 115) (setq H (max 0 (- H 100)))) ; s
((equal n 119) (setq H (min 3800 (+ H 100)))); w
)
(entdel (entlast))
(tt2)
(setq n (cadr (grread)))
)
(princ)
)
(defun tt2 ()
(setq a1 (atan (- (* R 2) H) (sqrt (- (* R H 4) (* H H)))))
(setq p4 (polar p3 (* a1 -1) R))
(setq p6 (polar p3 (* a1 -1) (* R 2)))
(setq p7 (polar p6 a1 R))
(setq p8 (polar p6 a1 (* R 2)))
(setq p9 (polar p8 (* pi -0.5) R))
(setq Lx (- Lt (* pi R 2) (* a1 R -4) L1))
(setq p10 (polar p9 0 Lx))
(command "PLINE" p1"W"95 95p2 "A" "CE"p3 p4p7 "CE"p8 p9"L"p10
"")
(setq L0 (- (* pi R 2) (* a1 R 4) (distance p2 p9))) ;剩余预留长度
(setq L2 (- (* pi R 2) (* R 4) L0))
(princ (strcat "\n拱高" (rtos H 2 0) "mm "))
(princ (strcat "剩余预留长度" (rtos L0 2 0) "mm "))
(princ (strcat "已拉伸长度" (rtos L2 2 0) "mm"))
)
;; 大概这个意思
页:
1
[2]