请大家帮忙修改下这个程序！当Ls=0时程序继续执行！
本帖最后由 quester 于 2015-8-15 08:06 编辑请大家帮忙修改，道路当没有缓和曲线及Ls=0时程序还能继续执行！
;;多义线摹拟缓和曲线。
;;输入起止直线、半径、缓和曲线长或设计车速。
;;命令：HH
(defun com_p()
(setq l 0)
(command "ucs" "o" (list (- 0 x1) 0 0))
(command "pline" (list 0 0 0) "w" "0" ""
(repeat 1000
(setq l (+ l (/ Ls 1000))
x (+ (- l (/ (* l l l l l) 40 C C)) (/ (* l l l l l l l l l) 3456 C C C C))
y (* id__ (+ (- (/ (* l l l) 6 C) (/ (* l l l l l l l) 336 C C C)) (/ (* l l l l l l l l l l l) 42240 C C C C C)))
);setq
(command (list x y 0))
);repaet
);command
(setq pt5 (trans (list x y 0) 1 0))
);com_p
(defun ll_v()
(setq V (getreal "\nGive Velocity:")
Ls1 (* V 0.85)
Ls2 (/ (* 0.0357 V V V) R)
Ls(max Ls1 Ls2 (/ R 9))
Ls(* (fix (/ Ls 10)) 10.0)
);setq
(if (> Ls R) (setq Ls R))
(ll_d)
);ll_v
(defun ll_d()
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq C (* Ls R)
q (- (+ (- (/ Ls 2) (/ (* Ls Ls Ls) 240 R R)) (/ (* Ls Ls Ls Ls Ls) 34560 R R R R)) (/ (* Ls Ls Ls Ls Ls Ls Ls) 8386560 R R R R R R))
pt1 (cdr (assoc 10 (entget (car p1))))
pt2 (cdr (assoc 11 (entget (car p1))))
pt10(polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))
pt3 (cdr (assoc 10 (entget (car p2))))
pt4 (cdr (assoc 11 (entget (car p2))))
pt20(polar pt3 (angle pt3 pt4) (/ (distance pt3 pt4) 2))
p (+ (- (/ (* Ls Ls) 24 R) (/ (* Ls Ls Ls Ls) 2688 R R R)) (/ (* Ls Ls Ls Ls Ls Ls) 506880 R R R R R))
jd(inters pt1 pt2 pt3 pt4 nil)
alf1(angle pt10 jd)
alf2(angle pt20 jd)
alf (- (angle jd pt20) alf1)
);setq
(if (or (> alf pi) (and (< alf 0) (> alf (- 0 pi))))
(progn
(setq id__ -1)
(if (> alf pi) (setq alf (- (+ pi pi) alf)) (setq alf (abs alf)))
);progn
(progn
(setq id__ 1)
(if (<= alf (- 0 pi)) (setq alf (+ pi pi alf)))
);progn
);if
(setq x0(/ (* (+ p R) (sin(/ alf 2.0))) (cos(/ alf 2.0)))
x1(+ x0 q)
Cl(+ (*alf R) Ls)
E (- (/ (+ R p) (cos(/ alf 2))) R)
);setq
(command "ucs" "o" jd)
(command "ucs" "z" (/ (* 180 alf1) pi))
(com_p) (setq pt6 pt5)
(setq ppt1 (list x1 0 0))
(command "ucs" "")
(command "ucs" "o" jd)
(command "ucs" "z" (/ (* 180 alf2) pi))
(setq id__ (- 0 id__)) (com_p)
(setq ppt2 (list x1 0 0))
(command "ucs" "")
(if (> (abs(distance jd pt1)) (abs(distance jd pt2)))
(setq ptt1 pt1)
(setq ptt1 pt2)
);if
(setq ptt2 (polar jd alf1 (- 0 x1)))
(thh p1 ptt1 10)
(thh p1 ptt2 11)
(if (> (abs(distance jd pt3)) (abs(distance jd pt4)))
(setq ptt3 pt3)
(setq ptt3 pt4)
);if
(setq ptt4 (polar jd alf2 (- 0 x1)))
(thh p2 ptt3 10)
(thh p2 ptt4 11)
(if (= id__ 1) (command "arc" pt5 "e" pt6 "r" R) (command "arc" pt6 "e" pt5 "r" R))
(setq alfd (angf alf))
(setvar "osmode" os)
(command "cmdecho" "1")
(command "text" pause pause "" (strcat "偏 角＝" alfd))
(command "cmdecho" "0")
(command "text" ""(strcat "半 径＝" (rtos R 2 3)))
(command "text" ""(strcat "切 线 长＝" (rtos x1 2 3)))
(command "text" ""(strcat "曲 线 长＝" (rtos Cl 2 3)))
(command "text" ""(strcat "外 距＝" (rtos E 2 3)))
(command "text" ""(strcat "缓和曲线长＝" (rtos Ls 2 3)))
);ll_d
(defun angf (alf)
(setq alff (angtos alf 1 6)
n 1
kk (strlen alff))
(repeat kk
(setq alfn (substr alff n 1))
(if (= alfn "d")
(setq nn n));if
(setq n (+ n 1))
);repeat
(strcat (substr alff 1 (- nn 1)) "%%" (substr alff nn))
);angf
(defun c:hh(/ p1 p2 pt1 pt2 pt3 pt4 pt5 pt6 pt10 pt20 id__ R V Ls E p3
r1 x y l x0 x1 C jd alf alf1 alf2 q p Cl Ls1 Ls2)
(command "ucs" "")
(setq p1 nil p2 nil)
(while (= p1 nil) (setq p1 (entsel "\n拾取第一条直线:")))
(redraw (car p1) 3)
(while (= p2 nil) (setq p2 (entsel "\n拾取第二条直线:")))
(redraw (car p2) 3)
(initget 1)
(setq R (getdist "\n请输入弯道半径 R:"))
(initget 1 "Ls V")
(setq p3 (getdist "\n输入缓和曲线长度(Ls)或[设计速度(V)]："))
(if (= p3 "V") (ll_v) (progn (setq ls p3) (ll_d)))
(princ)
);eline
(defun thh(len pt h)
(setq en_data (entget (car len))
old_data (assoc h en_data)
new_data (cons h pt)
en (subst new_data old_data en_data));setq
(entmod en)
);thh
再顶起继续求！ 主函数这样试试：(defun c:hh ()
(command "ucs" "")
(setq p1 nil p2 nil)
(while (= p1 nil) (setq p1 (entsel "\n拾取第一条直线:")))
(redraw (car p1) 3)
(while (= p2 nil) (setq p2 (entsel "\n拾取第二条直线:")))
(redraw (car p2) 3)
(initget 1)
(setq R (getdist "\n请输入弯道半径 R:"))
(initget 1 "Ls V")
(setq p3 (getdist "\n输入缓和曲线长度(Ls)或[设计速度(V)]："))
(if (= p3 "V") (ll_v) (progn (setq ls p3) (ll_d)))
(princ)
)
ZZXXQQ 发表于 2015-8-15 09:12 static/image/common/back.gif
主函数这样试试：
版主，会提示除数为零错误，只好Ls取极小值代替了~!
页:
[1]