CAD画缓和曲线lisp程序

CAD中画缓和曲线，首先复制本文☆后面的源程序保存至cad安装目录的SUPPORT文件夹，保存类型为.lsp 可以随便复制一个SUPPORT文件夹内的lsp文件，然后替换本文的程序。 打开CAD后，输入appload回车，找到你保存的缓和曲线lsp程序，点击加载，然后就可以画缓和曲线了。 首先，要画出缓和曲线的两条直线，然后输入HH回车，按提示完成缓和曲线。 注：本程序，缓和曲线段拟合长度为0.4m，如需更改拟合长度，将程序的第8行(repeat (FIX(/ Ls 0.4))及9行(setq l (+ l (/ Ls (FIX(/ Ls 0.4))))中的0.4修改即可。 ☆

;;多义线摹拟缓和曲线。

;;输入起止直线、半径、缓和曲线长或设计车速。 ;;命令：HH

(defun com_p() (setq l 0)

(command \ (command \ (repeat (FIX(/ Ls 0.4))

(setq l (+ l (/ Ls (FIX(/ Ls 0.4))))

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 \ 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 \ (setvar \ (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 \

(command \ (com_p) (setq pt6 pt5) (setq ppt1 (list x1 0 0)) (command \ (command \

(command \ (setq id__ (- 0 id__)) (com_p) (setq ppt2 (list x1 0 0)) (command \

(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 \ (setq alfd (angf alf)) (setvar \ (command \

(command \偏 角＝\ (command \

(command \ (strcat \半 径＝\ (command \ (strcat \切线长＝\ (command \ (strcat \曲线长＝\ (command \ (strcat \外 距＝\ (command \ (strcat \缓曲长＝\ );ll_d

(defun angf (alf)

(setq alff (angtos alf 1 4) n 1

kk (strlen alff)) (repeat kk

(setq alfn (substr alff n 1)) (if (= alfn \ (setq nn n));if (setq n (+ n 1)) );repeat

(strcat (substr alff 1 (- nn 1)) \ );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 \ (setq p1 nil p2 nil)

(while (= p1 nil) (setq p1 (entsel \拾取第一条直线:\ (redraw (car p1) 3)

(while (= p2 nil) (setq p2 (entsel \拾取第二条直线:\ (redraw (car p2) 3)

(initget 1)

(setq R (getdist \请输入圆曲线半径 R: \ (initget 1 \

(setq p3 (getdist \输入缓和曲线长度(Ls)或[设计速度(V)]： \ (if (= p3 \ (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

本文来源：https://www.bwwdw.com/article/cb7h.html