CAD道路工程中缓和曲线的画法缓和曲线AutoLISP 应用程序一、制作缓和曲线AutoLISP 应用程序复制AutoLISP程序源代码，打开“记事本”，粘贴进去后，另存为文件名“缓和曲线.LSP”，保存类型为“所有文件”（AutoLISP程序源代码见附件）二、加载缓和曲线AutoLISP应用程序在命令行输入“appload”打开自动加载对话框。

在对话框的“查找范围”里找到“缓和曲线.LSP”的那个程序，选中后，点击【加载】，显示“已成功加载缓和曲线.LSP”后，关闭对话框，ok你那个程序自动启动加载了。

三、在CAD中画出切线四、运行程序在命令行中输入hh回车五、选择两条切线，然后输入曲线半径如：400回车六、输入缓和曲线长，如100，绘图完成！附件：缓和曲线AutoLISP 程序源代码(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 2)))(command "text" "" (strcat "切线长＝" (rtos x1 2 2)))(command "text" "" (strcat "曲线长＝" (rtos Cl 2 2)))(command "text" "" (strcat "外距＝" (rtos E 2 2)))(command "text" "" (strcat "缓和曲线长＝" (rtos Ls 2 2))));ll_d(defun angf (alf)(setq alff (angtos alf 1 4)n 1kk (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 p3r1 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。