用交点法绘制公路曲线

ashleytgg · 发表于 2015-3-30 10:29:20

在传一遍

ashleytgg · 发表于 2015-3-30 10:36:06

怎么传不上去

mdxcad · 发表于 2016-1-17 06:48:56

skg123 · 发表于 2016-1-24 20:41:57

下下来试试看好用不

skg123 · 发表于 2016-1-24 20:45:20

下载后，你们文件太多，楼主能否讲一下使用方法

ashleytgg · 发表于 2016-1-25 09:10:01

我也好久没用了，怎么用也不太清楚了，你看看这个链接，我后来改的。http://bbs.mjtd.com/thread-170360-1-1.html ，相关用法见这个帖子。

;;对一个二维点集合group_point 绕点center 旋转 ang 弧度
(defun rotate_group_point (group_point ang center / lst)
(setq group_point
(mapcar '(lambda (point)
(list (- (car point) (car center))
(- (cadr point) (cadr center))
)
)
group_point
)
)
(setq lst (list (list (cos ang) (* (sin ang) -1))
(list (sin ang) (cos ang))
)
)
(setq group_point
(mapcar '(lambda (point)
(apply '(lambda (element_1 element_2)
(list (+ (* (car element_1) (car point))
(* (cadr element_1) (cadr point))
)
(+ (* (car element_2) (car point))
(* (cadr element_2) (cadr point))
)
)
)
lst
)
)
group_point
)
)
(setq
group_point
(mapcar '(lambda (x)
(list (+ (car x) (car center))
(+ (cadr x) (cadr center))
)
)
group_point
)
)
)
;; 8888888888888888 88888888888888888888888 88888888888888888
;;定义一个队group_data_out 数组进行群变换的函数，group_data_out 结构为：(Z_桩号 U ang_象限角 )
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度
(defun transformation_group_data_out
(group_data_out
reflex data_origin
data_insert /
group_point quadrant_ang
ang_Δ ang
U_origin U_insert
group i
)
(setq group (append (list data_origin) group_data_out))
(if (= reflex -1)
(setq group
(mapcar '(lambda (lst / Z U ang)
(setq Z (car lst)
U (cadr lst)
ang (caddr lst)
)
(list Z
(list (car U)
(* (cadr U) -1)
)
(* ang -1)
)
)
group
)
)
) ; (if (= reflex -1) 函数结束
(setq data_origin (car group)
group_data_out (cdr group)
)
;; 对group_data_out 数组进行平移,使得原坐标系中的U_origin点，和实际线元的起点U_insert向符合
(setq U_origin (cadr data_origin)
U_insert (cadr data_insert)
)
(setq group_data_out
(mapcar '(lambda (lst / Z U x y ang)
(setq Z (car lst)
U (cadr lst)
x (+ (- (car U) (car U_origin))
(car U_insert)
)
y (+ (- (cadr U) (cadr U_origin))
(cadr U_insert)
)
ang (caddr lst)
)
(list Z (list x Y) ang)
)
group_data_out
)
)
;; 对 group_data_out 数组,以线元的起点U_insert进行旋转 quadrant_ang- ang 角度操作
(setq ang (caddr data_origin)
quadrant_ang (caddr data_insert)
)
(setq group_point
(mapcar 'cadr group_data_out)
)
(setq ang_Δ (- quadrant_ang ang)
group_point (rotate_group_point group_point ang_Δ U_insert)
)
(setq i 0
group_data_out
(mapcar '(lambda (lst / U ang)
(setq U (nth i group_point)
ang (caddr lst)
i (+ i 1)
)
(list (car lst) U (+ ang ang_Δ))
)
group_data_out
)
)
) ; (defun transformation_group_data_out 函数结束
;; (transformation_group_data_out group_data_out reflex data_origin data_insert)
;;888888888888888888888888888888888888888888888888888888888888888888888888888888
;; 人口变量, 缓和曲线参数A, 缓和曲线长L
(defun solve_transition_curve_sub (A L /
group U deflection
functon_parameter
)
;; (setq L 40.0 A 200 )
(if (> L 0.000001)
(progn
(setq L (* L 1.0)
A (* A 1.0)
)
(setq functon_parameter
'(((1 0 1.0 1)
(5 4 40.0 -1)
(9 8 3456.0 1)
(13 12 599040.0 -1)
(17 16 1.75473e+007 1)
)
((3 2 6.0 1)
(7 6 336.0 -1)
(11 10 42240.0 1)
(15 14 9.6768e+006 -1)
(19 18 3.5301e+009 1)
)
)
)
;; 把 L A 带入函数进行求值
(setq group
(mapcar '(lambda (subset)
(mapcar '(lambda (lst)
(apply '(lambda (a_1 a_2 a_3 a_4)
(* (/ (expt L a_1)
(* (expt A a_2) a_3)
)
a_4
)
)
lst
)
)
subset
)
)
functon_parameter
)
)
(setq U
(mapcar '(lambda (subset)
(apply '+ subset)
)
group
)
)
(setq deflection
(/ (expt L 2.0) (* (expt A 2.0) 2.0))
) ; J为弧度
(list U deflection)
) ; progn函数结束
;; 当缓和曲线长L很小时
(list '(0 0) 0)
) ; if 函数结束
)
;; 输出参数为切线支距坐标复数U,偏角deflection
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888
;; 当线元是缓和曲线时， subset 数据结构为
;; ( R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )
(defun solve_transition_curve (group_Z subset /
A Lh lst
Lh_start Lh_end U_Z_start
β_start Z_end group_data_out
data_origin data_insert
)
(apply
'(lambda (R_start R_end transition_parameter
reflex quadrant_ang Z_start
U_insert
)
(setq Lh (car transition_parameter) ; 缓和曲线长度
A (cadr transition_parameter) ; 缓和曲线参数
R_start (* R_start 1.0)
R_end (* R_end 1.0)
)
(if (= R_start 0)
(setq R_start (expt 10.0 30))
)
(if (= R_end 0)
(setq R_end (expt 10.0 30))
)
(if (> R_start R_end)
;; 正向缓和曲线时
(progn
(setq Lh_start (/ (expt A 2) R_start) ; 起点缓和曲线长度
lst (solve_transition_curve_sub A Lh_start)
U_Z_start (car lst) ; 缓和曲线的起点切线支距坐标
β_start (cadr lst) ;缓和曲线起点象限角
)
;; 对桩号集合group_Z 进行操作
(setq group_data_out
(mapcar '(lambda (z / L lst U_Z β_Z)
(setq L (+ (- Z Z_start) Lh_start))
(setq lst (solve_transition_curve_sub A L)
U_Z (car lst)
β_Z (cadr lst)
)
(list Z U_Z β_Z)
)
group_Z
)
)
)
;; 反向缓和曲线时
(progn
(setq Lh_start (/ (expt A 2) R_start)
lst (solve_transition_curve_sub A Lh_start)
U_Z_start (car lst)
β_start (cadr lst)
)
(setq Lh_end (/ (expt A 2) R_end) ; 终点缓和曲线长度
Z_end (+ Z_start Lh)
)
(setq group_data_out
(mapcar '(lambda (z / L lst U_Z β_Z)
(setq L (+ (- Z_end Z) Lh_end))
; 加桩点的缓和曲线长度，从完整缓和曲线的起点算起
(setq lst (solve_transition_curve_sub A L)
U_Z (car lst)
β_Z (cadr lst)
)
(list Z U_Z β_Z)
)
group_Z
)
)
;;此时生成的group_data_out与标准的正向缓和曲线线(原点0，启始方位角0，右手螺旋坐标系) 沿着X轴对称，
;;所以要对group_data_ou 进行沿x轴镜像
(setq group_data_out
(mapcar '(lambda (lst / Z U ang)
(setq Z (car lst)
U (cadr lst)
ang (caddr lst)
)
(list Z
(list (* (car U) -1)
(cadr U)
)
(* ang -1)
)
)
group_data_out
)
U_Z_start
(list (* (car U_Z_start) -1)
(cadr U_Z_start)
)
β_start
(* β_start -1)
)
)
) ; (if (> R_start R_end) 函数结束
;; 创建transformation_group_data_out 函数用参数 data_origin data_insert
(setq data_origin (list 0 U_Z_start β_start)
data_insert (list 0 U_insert quadrant_ang)
)
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度
(transformation_group_data_out
group_data_out
reflex
data_origin
data_insert
)
)
subset
)
)
;;88888888888888888888888888888888888888888888888888888888888888888 (expt 10.0 30)
;; 当线元是圆曲线时 subset 数据结构为
;; ( R_start R_end lenth reflex quadrant_ang Z_start U_insert )
(defun solve_circular_arc (group_Z subset /
i group_data_out
U_center data_origin data_insert
)
;; (tang_test group_data_out )
(apply
'(lambda (R_start R_end lenth reflex quadrant_ang Z_start U_insert)
;; 设定圆曲线圆心为原点(0 R_start)，方向为右手坐标系，圆曲线线起点坐标(0 0 ),切线为X轴
(setq R_start (* R_start 1.0)
U_center (list 0 R_start)
)
(setq group_data_out
(mapcar '(lambda (Z / L β U_Z ang)
(setq L (- Z Z_start)
β (/ L R_start)
ang (- β (/ pi 2))
U_Z (polar U_center ang R_start)
)
(list Z U_Z β)
)
group_Z
)
)
;; 创建transformation_group_data_out 函数用参数 data_origin data_insert
(setq data_origin (list 0 (list 0 0) 0)
data_insert (list 0 U_insert quadrant_ang)
)
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度
(transformation_group_data_out
group_data_out
reflex
data_origin
data_insert
)
)
subset
)
)
;;88888888888888888888888888888888888888888888888888888888888888888
;; 当线元是直线时 subset 数据结构为
;; ( R_start R_end lenth reflex quadrant_ang Z_start U_insert )
(defun solve_straightway
(group_Z subset / group_data_out)
;; (tang_test group_data_out )
(apply
'(lambda (R_start R_end lenth reflex quadrant_ang Z_start U_insert)
(setq group_data_out
(mapcar '(lambda (Z / L U_Z)
(setq L (- Z Z_start)
U_Z (polar U_insert quadrant_ang L)
)
(list Z U_Z quadrant_ang)
)
group_Z
)
)
)
subset
)
)
;;88888888888888888888888888888888888888888888888888888888888888888
;; 创建一个桩号的函数
(defun create_group_Z (Z_start Z_end Z_Δ / lst group_Z z)
(setq group_z (list Z_start)
Z (+ (fix Z_start) 1)
)
(while (< Z Z_end)
(setq group_Z (cons z group_Z))
(setq z (+ z Z_Δ))
)
(setq group_z
(reverse group_z)
)
(append group_z (list Z_end))
)
;; (setq group_Z ( create_group_Z 10784.9 10834 1) )
(defun f_zhuanghao (Z / 桩号1 桩号2 Z_1 z_2 z_3 桩号3 桩号)
(setq Z_1 (fix Z)
Z_2 (rem Z_1 1000) ;整数桩号
Z_3 (/ (- Z_1 Z_2) 1000) ;公里桩号
Z_4 (- Z Z_1) ;小数桩号
)
(setq 桩号1 (itoa Z_3) ;获得整公里桩号
桩号2 (itoa Z_2) ;获得桩号的小里程数
桩号3 (substr (rtos Z_4 2 3) 2 4) ;获得桩号的小数
)
(cond
((and (= Z_2 0) (= Z_4 0))
(setq 桩号 (strcat "K" 桩号1 "+000"))
; 获得桩号的字符表达式如"K3+000" 的形式
)
((and (= (rem Z_2 10) 0) (= Z_4 0))
(setq 桩号 (strcat "+" 桩号2))
; 获得桩号的字符表达式如"+860" 的形式
)
(t (setq 桩号 (strcat "K" 桩号1 "+" 桩号2 桩号3)))
)
) ;zhuanghao函数结束
;;8888888888888888888888888888888888888888888888
;; 交点参数的文件格式, 当交点为完整缓和曲线时 : [ ( 转点号I nil) U_转点 ( Ls1 R Ls2 ) ] ，
;; 当交点为非完整缓和曲线交点时 : [ ( 转点号I t) U_转点 ( R_start R R_end Ls1 Ls2) ]
;; 输出变量turning_point_group : [ ( 转点号I nil) U_转点 ( Ls1 R Ls2 )(α1 α2 Δ Dist_1 Dist_2 )]
(defun create_turning_point_group
(/ n i lst
fname group turning_point_group
f1
;; 求交点距离角度时用到的参数
α1 α2 Δ Dist_1
Dist_2 lst_1 lst_2 lst_3
U_1 U_2 U_3
)
;; turning_point_group 格式 [ ( 转点号I nil) U_转点 ( Ls1 R Ls2 ) ] , 完整缓和曲线时
;; or [ ( 转点号I nil) U_转点 ( R_start R R_end Ls1 Ls2) ] , 非完整缓和曲线交点时
(setq fname (getfiled "输入存放交点参数的文件" "" "txt" 1))
(setq f1 (open fname "r"))
(setq group nil)
(while (setq lst (read-line f1))
(setq group (cons lst group))
) ; while (/= list nil)循环函数结束
(close f1)
(setq i 0
group_turning_point
nil
n (length group)
)
(repeat n
(setq lst (read (nth i group))
group_turning_point
(cons lst group_turning_point)
)
(setq i (+ i 1))
)
(setq group_turning_point
(vl-sort group_turning_point
'(lambda (lst1 lst2)
(< (car (car lst1))
(car (car lst2))
)
)
)
)
;; 对数组group_turning_point [ ( 转点号I nil) U_转点 ( Ls1 R Ls2 ) ] ，加入第三项 (α1 α2 Δ Dist_1 Dist_2 )
(setq i 0
group nil
)
(repeat n
(cond
;;当转点为[第二个->倒数第二个] 转点时
((and (/= i 0) (/= i (- n 1)))
(progn
(setq lst_1 (nth (- i 1) group_turning_point))
(setq lst_2 (nth i group_turning_point))
(setq lst_3 (nth (+ i 1) group_turning_point))
(setq U_1 (cadr lst_1)
U_2 (cadr lst_2)
U_3 (cadr lst_3)
)
(setq Dist_1 (distance U_1 U_2)
Dist_2 (distance U_2 U_3)
)
(setq α1 (angle U_1 U_2)
α2 (angle U_2 U_3)
Δ (- α2 α1)
)
;; 对转角Δ 使其控制在(-pi pi) 之间
(cond
((and (>= Δ (* -1 pi))
(< Δ pi)
)
(setq Δ Δ)
)
((< Δ (* -1 pi))
(setq Δ (+ Δ (* 2 pi)))
)
((> Δ pi)
(setq Δ (- Δ (* 2 pi)))
)
)
(setq lst (list α1 α2 Δ Dist_1 Dist_2)
lst (append lst_2 (list lst))
group (cons lst group)
)
)
)
;;当为第一个转点时的情形起始转点->下一转点
((= i 0)
(progn
(setq lst_2 (nth i group_turning_point))
(setq lst_3 (nth (+ i 1) group_turning_point))
(setq
U_2 (cadr lst_2)
U_3 (cadr lst_3)
)
(setq Dist_1 0
Dist_2 (distance U_2 U_3)
α2 (angle U_2 U_3)
lst (list 0 α2 0 0 Dist_2)
)
(setq lst (append lst_2 (list lst))
group (cons lst group)
)
)
)
;; 当转点为最后一个转点时的情形上一转点->终点转点
((= i (- n 1))
(progn
(setq lst_1 (nth (- i 1) group_turning_point))
(setq lst_2 (nth i group_turning_point))
(setq U_1 (cadr lst_1)
U_2 (cadr lst_2)
)
(setq Dist_1 (distance U_1 U_2)
α1 (angle U_1 U_2)
lst (list α1 0 0 Dist_1 0)
)
(setq lst (append lst_2 (list lst))
group (cons lst group)
)
)
)
) ; cond 函数结束
(setq i (+ i 1))
) ; (repeat n 函数结束
(setq group_turning_point (reverse group))
; 排序函数结束
) ; create_turning_point_group_2 函数结束
;; (setq group_turning_point ( create_turning_point_group ) )
;;888888888888888888888888888888888888888888888888888888888888888888888888888888
;; 人口变量缓和曲线长Lh, 缓和曲线半径R，出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A
(defun evaluation_transition_curve
(Lh R /
A p q
β group
functon_parameter
)
;; (setq lh 50 r 480 )
(setq R (* 1.0 R)
Lh (* 1.0 Lh)
)
(setq functon_parameter
'(((2 1 24.0)
(4 3 -2688.0)
(6 5 506880.0)
(8 7 -1.54829e+008)
)
((1 0 2.0)
(3 2 -240.0)
(5 4 34560.0)
(7 6 -8.38656e+006)
(9 8 3.15851e+009)
)
)
)
;;把参数parameter_easement_curve 带入求值，
(setq group
(mapcar '(lambda (subset)
(mapcar '(lambda (lst)
(apply '(lambda (a_1 a_2 a_3)
(/ (expt Lh a_1)
(* (expt R a_2) a_3)
)
)
lst
)
)
subset
)
)
functon_parameter
)
)
(setq group
(mapcar '(lambda (subset)
(apply '+ subset)
)
group
)
)
(setq p (car group)
q (cadr group)
β (/ Lh (* R 2.0))
A (sqrt (* R Lh))
)
;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A
(list p q β A)
) ; evaluation_easement_curve 函数结束
;; (evaluation_transition_curve 50 480 ) (evaluation_transition_curve 50 480 )
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888
;;888888888888888888888888888888888888888888888888888888888888888888888888888888
;; (setq group_turning_point ( create_turning_point_group ) )
;; 求基本对称路线平曲线的曲线要素入口变量: [ ( 转点号I nil) U_转点 ( Lh R Lh )(α1 α2 Δ Dist_1 Dist_2 )]
;; 出口变量:该转点各线元的数据[( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ) ]
(defun evaluation_symmetrical_curve (subset / Z_I U group_data_out)
;; (setq subset (nth 15 group_turning_point ))
(setq Z_I (car (car subset)) ; 转点编号
subset (cdr subset)
)
;; (setq U_ZD_real (car subset) lst1 (cadr subset) lst2 (caddr subset) )
(apply '(lambda (U_ZD_real lst1 lst2 /
;; 计算交点用参数
quadrant_ang Δ
;; 计算切线长度 T1 T2 所用参数
T1 T2 a_1 a_2 tangent
cscΔ cotΔ
;; 计算缓和曲线的内蕴参数
parameter Lh1 Lh2 R
A1 A2 p1 p2 q1
q2 β1 β2 βy E
Ly L adjusted_value reflex
;; 建立线元坐标系所用参数
U_center U_JD U_ZH U_HY U_QZ
U_YH U_HZ
;; 桩号用参数
Z_JD Z_ZH Z_HY Z_QZ Z_YH
Z_HZ
;; 切线角用参数
ang_JD ang_ZH ang_HY ang_QZ ang_YH
ang_HZ
;; 对数组 group_data_out 进行移位，镜像，旋转用参数
quadrant_ang data_origin data_insert
;;创建线元列表所用参数
lst lst2 lst3 lst4 Line_segments
)
(setq Lh1 (car lst1)
R (cadr lst1)
Lh2 (caddr lst1)
quadrant_ang
(car lst2) ; 设计交点的入口方位角
Δ (caddr lst2) ; 设计交点偏转系数
)
(if (>= Δ 0)
(setq reflex 1)
(setq reflex -1
Δ (* -1 Δ)
)
)
(setq
parameter
(evaluation_transition_curve Lh1 R)
;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A
p1 (car parameter)
q1 (cadr parameter)
β1 (caddr parameter)
A1 (nth 3 parameter)
)
(cond
((= Lh1 Lh2)
(setq
β2 β1
A2 A1
)
(setq tangent (/ (sin (/ Δ 2)) (cos (/ Δ 2)))
T1 (+ (* (+ R p1) tangent) q1)
T2 T1
; 切线长度
)
)
;; 当出口、进口缓和曲线长度不相等时
((/= Lh1 Lh2)
(setq
parameter
(evaluation_transition_curve Lh2 R)
;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A
p2 (car parameter)
q2 (cadr parameter)
β2 (caddr parameter)
A2 (nth 3 parameter)
)
(setq cscΔ (/ 1.0 (sin Δ))
cotΔ (/ (cos Δ) (sin Δ))
a_1 (* (+ R p2) cscΔ)
a_2 (* (+ R p1) cotΔ)
T1 (+ (- a_1 a_2)
q1
)
a_1 (* (+ R p1) cscΔ)
a_2 (* (+ R p2) cotΔ)
T2 (+ (- a_1 a_2)
q2
)
)
)
) ; (cond 函数结束
(setq a_1 (expt (+ R p1) 2)
a_2 (expt (- T1 q1) 2)
E (- (sqrt (+ a_1 a_2)) R) ; 外距
βy (- Δ (+ β1 β2))
Ly (* βy R)
; 圆曲线长度
L (+ Ly (+ Lh1 Lh2))
adjusted_value (- (+ T1 T2) L) ; 切曲差
)
;; 以ZH点为坐标原点，该点的切线方向为X轴，建立右手螺旋坐标系 ,转角 Δ取正数
;;转点的桩号 Z_JD = z_QZ + adjusted_value
(setq ang_JD (/ Δ 2)
;; 设置为U_JD ->U_center的垂直方向
ang_ZH 0
ang_HY β1
ang_QZ (+ β1 (/ βy 2))
ang_YH (- Δ β2)
ang_HZ Δ
)
;; (angtos (+(/ (- pi Δ) 2)Δ) 1 6 )
(setq
U_JD (list T1 0)
U_center (list q1 (+ R p1))
U_ZH (list 0 0) ;向量U_center ->U_JD 的方位角 (+ (/ Δ 2)pi)
U_HY (polar U_center (- ang_HY (* pi 0.5)) R)
U_QZ (polar U_center (- ang_QZ (* pi 0.5)) R)
U_YH (polar U_center (- ang_YH (* pi 0.5)) R)
U_HZ (polar U_JD Δ T2)
)
(setq Z_JD T1
Z_ZH 0
Z_HY Lh1
Z_QZ (+ Lh1 (/ Ly 2))
Z_YH (+ Lh1 Ly)
Z_HZ L
)
(setq group_data_out
(list
(list Z_JD U_JD ang_JD)
(list Z_ZH U_ZH ang_ZH)
(list Z_HY U_HY ang_HY)
(list Z_QZ U_QZ ang_QZ)
(list Z_YH U_YH ang_YH)
(list Z_HZ U_HZ ang_HZ)
)
)
;; 创建transformation_group_data_out 函数用参数 data_origin data_insert
(setq
data_origin (list 0 U_JD 0)
data_insert (list 0 U_ZD_real quadrant_ang)
)
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度quadrant_ang
(setq group_data_out
(transformation_group_data_out
group_data_out
reflex
data_origin
data_insert
)
)
;;利用group_data_out数组设置线元参数: (( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )
(cond
((and (/= Lh1 0)
(/= Lh2 0)
)
(setq lst (list 1 2 4)
lst3 (list 0 1 2)
)
)
((and (= Lh1 0)
(/= Lh2 0)
)
(setq lst (list 2 4)
lst3 (list 1 2)
)
)
((and (/= Lh1 0)
(= Lh2 0)
)
(setq lst (list 1 2)
lst3 (list 0 1)
)
)
((and (= Lh1 0)
(= Lh2 0)
)
(setq lst (list 2)
lst3 (list 1)
)
)
) ; cond 函数结束
(setq
group
(mapcar '(lambda (i / lst2)
(setq lst2 (nth i group_data_out))
(list (caddr lst2) (car lst2) (cadr lst2))
)
(list 1 2 4)
)
lst_4 (list (list (list Z_I 0) 0 R (list Lh1 A1) reflex)
(list (list Z_I 1) R R Ly reflex)
(list (list Z_I 2) R 0 (list Lh2 A2) reflex)
)
Line_segments (mapcar '(lambda (i)
(append (nth i lst_4) (nth i group))
)
lst3
)
)
(list Line_segments (list T1 T2 adjusted_value))
)
subset
)
) ; evaluation_easement_curve 函数结束
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888
;;888888888888888888888888888888888888888888888888888888888888888888888888888888
;; (setq group_turning_point ( create_turning_point_group ) )
;; 求包含非完整缓和曲线的线元要素入口变量: [ ( 转点号I T) U_转点 ( R_start R R_end Lh1 Lh2 )(α1 α2 Δ Dist_1 Dist_2 )]
;; 出口变量:该转点各线元的数据[( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ) ]
(defun evaluation_no_symmetrical_curve (subset / Z_I U group_data_out)
;; (setq subset (nth 11 group_turning_point ))
(setq Z_I (car (car subset)) ; 转点编号
subset_2 (cdr subset)
)
;; (setq U_ZD_real (car subset_2) lst1 (cadr subset_2) lst2 (caddr subset_2) )
(apply '(lambda (U_ZD_real lst1 lst2 /
;; 计算交点用参数
quadrant_ang Δ
;; 计算切线长度 T1 T2 所用参数
T1 T2 group_Z Lh1_start Lh2_start
;; 计算缓和曲线的内蕴参数
parameter Lh1 Lh2 R A1
A2 p1 p2 q1 q2
β1 β2 βy E Ly
L adjusted_value reflex
;; 建立线元坐标系所用参数
U_center U_ZD U_ZH U_HY U_QZ
U_YH U_HZ
;; 桩号用参数
Z_JD Z_ZH Z_HY Z_QZ Z_YH
Z_HZ
;; 切线角用参数
ang_JD ang_ZH ang_HY ang_QZ ang_YH
ang_HZ
;; 对数组 group_data_out 进行移位，镜像，旋转用参数
quadrant_ang data_origin data_insert
;;创建线元列表所用参数
lst lst2 lst3 lst4 Line_segments
)
(setq R_start (car lst1)
R (cadr lst1)
R_end (caddr lst1)
Lh1 (nth 3 lst1)
Lh2 (nth 4 lst1)
quadrant_ang
(car lst2) ; 设计交点的入口方位角
Δ (caddr lst2) ; 设计交点偏转系数
)
(if (= R_start 0)
(setq R_start (expt 10.0 30))
)
(if (= R_end 0)
(setq R_end (expt 10.0 30))
)
(if (>= Δ 0)
(setq reflex 1)
(setq reflex -1
Δ (* -1 Δ)
) ; (setq Δ (/ pi 3))
)
;; 当出口缓和曲线长度不相等时
(if (/= Lh1 0)
(progn
;; 创建lst结构 ( ( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )
(setq
A1
(abs (- (/ 1.0 R)
(/ 1.0 R_start)
)
)
A1
(sqrt (/ Lh1 A1))
)
;; 求入口非完整缓和曲线的HY点 ( z_桩号 U_z ang )
(setq lst (list R_start
R
(list Lh1 A1)
1
0 ; 线元的起点方位角
0
(list 0 0)
)
group_Z (list Lh1)
)
(setq group (solve_transition_curve group_Z lst)
U_HY (cadr (car group))
β1 (caddr (car group))
)
;; (setq group_data_out (solve_transition_curve ( create_group_Z 0 Lh1 1) lst )) (tang_test group_data_out )
)
(setq β1 0) ; 当Lh1长度为0 时， β1 偏角为0
)
;; 求出口口非完整缓和曲线的HY点 ( z_桩号 U_z ang ) (以YH点为0点，右手螺旋坐标系，过YH点的切线为0度 )
(if (/= Lh2 0)
(progn
;; 创建lst结构 ( R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )
(setq
A2
(abs (- (/ 1.0 R)
(/ 1.0 R_end)
)
)
A2
(sqrt (/ Lh2 A2))
)
(setq lst (list R
R_end
(list Lh2 A2)
1
0 ; 线元的起点方位角
0
(list 0 0)
)
group_Z (list Lh2)
)
(setq group (solve_transition_curve group_Z lst)
β2 (caddr (car group))
)
)
(setq β2 0) ; 当Lh2长度为0 时， β2 偏角为0
) ; (if (/= Lh2 0) 函数结束
;; 计算圆曲线的偏角
(setq βy (- Δ (+ β2 β1))
Ly (* R βy) ; 圆曲线长度
)
;; 创建lst结构 ( R_start R_end lenth reflex quadrant_ang Z_start U_insert )
(setq lst (list R R Ly 1 β1 0 U_HY)
group_Z (list Ly) ; YH 点的桩号
)
(setq group (solve_circular_arc group_Z lst)
; 求圆曲线的终点坐标
U_YH (cadr (car group))
)
;; (setq group_data_out (solve_circular_arc ( create_group_Z 0 Ly 1) lst )) (tang_test group_data_out )
(if (/= Lh2 0)
(progn
;;求HZ点的 group_data_out 的数组( z_桩号 U_z ang )
(setq lst (list R
R_end
(list Lh2 A2)
1
(+ βy β1) ; 线元的起点方位角
0 ; 线元的起始桩号
U_YH
)
group_Z (list Lh2) ; HZ点桩号
)
(setq group (solve_transition_curve group_Z lst)
U_HZ (cadr (car group))
; 求第二缓和曲线在以HZ点为坐标原点，起点缓和曲线切线为X轴方向
)
;; (setq group_data_out (solve_transition_curve ( create_group_Z 0 Lh2 1) lst )) (tang_test group_data_out )
)
(setq U_HZ U_YH)
) ; (if (/= Lh2 0) 函数结束
;; 求次坐标系中的转点坐标 U_ZD
(setq U_HZ_2 (polar U_HZ Δ 100.0)
U_ZD (inters U_HZ
U_HZ_2
(list 0 0)
(list 10000 0)
nil
)
)
;; (setq tang99 (list (list 0 0) U_HY U_YH U_HZ U_ZD ))( create_LWPOLYLINE tang99 nil "0" )
(setq T1 (car U_ZD)
T2 (distance U_ZD U_HZ)
L (+ Ly (+ Lh1 Lh2))
adjusted_value (- (+ T1 T2) L) ; 切曲差
)
;; 以ZH点为坐标原点，该点的切线方向为X轴，建立右手螺旋坐标系 ,转角 Δ取正数
;;转点的桩号 Z_JD = z_QZ + adjusted_value
(setq ang_JD (/ Δ 2)
;; 设置为U_JD ->U_center的垂直方向
ang_ZH 0
ang_HY β1
ang_QZ (+ β1 (/ βy 2))
ang_YH (- Δ β2)
ang_HZ Δ
)
;; (angtos (+(/ (- pi Δ) 2)Δ) 1 6 )
(setq
U_center (polar U_HY (+ ang_HY (* pi 0.5)) R)
U_ZH (list 0 0) ;向量U_center ->U_JD 的方位角 (+ (/ Δ 2)pi)
U_QZ (polar U_center (- ang_QZ (* pi 0.5)) R)
)
(setq Z_JD T1
Z_ZH 0
Z_HY Lh1
Z_QZ (+ Lh1 (/ Ly 2))
Z_YH (+ Lh1 Ly)
Z_HZ L
)
(setq group_data_out
(list
(list Z_JD U_ZD ang_JD)
(list Z_ZH U_ZH ang_ZH)
(list Z_HY U_HY ang_HY)
(list Z_QZ U_QZ ang_QZ)
(list Z_YH U_YH ang_YH)
(list Z_HZ U_HZ ang_HZ)
)
)
;; 创建transformation_group_data_out 函数用参数 data_origin data_insert
(setq
data_origin (list 0 U_ZD 0)
data_insert (list 0 U_ZD_real quadrant_ang)
)
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度quadrant_ang
(setq group_data_out
(transformation_group_data_out
group_data_out
reflex
data_origin
data_insert
)
)
;;利用group_data_out数组设置线元参数: ( R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )
(cond
((and (/= Lh1 0)
(/= Lh2 0)
)
(setq lst (list 1 2 4)
lst3 (list 0 1 2)
)
)
((and (= Lh1 0)
(/= Lh2 0)
)
(setq lst (list 2 4)
lst3 (list 1 2)
)
)
((and (/= Lh1 0)
(= Lh2 0)
)
(setq lst (list 1 2)
lst3 (list 0 1)
)
)
((and (= Lh1 0)
(= Lh2 0)
)
(setq lst (list 2)
lst3 (list 1)
)
)
) ; cond 函数结束
(setq
group
(mapcar '(lambda (i / lst2)
(setq lst2 (nth i group_data_out))
(list (caddr lst2) (car lst2) (cadr lst2))
)
(list 1 2 4)
)
lst_4 (list (list (list Z_I 0) R_start R (list Lh1 A1) reflex)
(list (list Z_I 1) R R Ly reflex)
(list (list Z_I 2) R R_end (list Lh2 A2) reflex)
)
Line_segments (mapcar '(lambda (i)
(append (nth i lst_4) (nth i group))
)
lst3
)
)
(list Line_segments (list T1 T2 adjusted_value))
)
subset_2
)
) ; evaluation_easement_curve 函数结束
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888
;; (setq group_turning_point ( create_turning_point_group ) )
;; 求线路的线元参数group_Line_segments [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ]
;; 以及转点参数 group_data_JD ( Z_JD U ang JD reflex )
(defun create_group_Line_segments
(group_turning_point
Z_road_start /
group_turning_point_2
lst state
i dist
quadrant_ang num
T_front Δ
U_insert U
Z group_parameter
group_Line_segments
group_data_JD
)
;; 去掉group_turning_point 中的第一和最后一个转点，不进行处理
(setq group_turning_point_2
(cdr group_turning_point)
group_turning_point_2
(reverse group_turning_point_2)
group_turning_point_2
(cdr group_turning_point_2)
group_turning_point_2
(reverse group_turning_point_2)
)
;; 创建线元集合group_Line_segments [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ]
;; 和转点用的参数集合 group_parameter (list T1 T2 adjusted_value)
(setq
group_Line_segments
nil
group_parameter
nil
)
(mapcar '(lambda ; (setq subset (nth 9 group_turning_point ) )
(subset / Line_segments state lst lst2)
(setq state (cadr (car subset)))
; 判断该转点是否包含非完整缓和曲线
(if state
(setq lst
(evaluation_no_symmetrical_curve subset)
Line_segments
(car lst)
lst2 (cadr lst)
)
(setq lst
(evaluation_symmetrical_curve subset)
Line_segments
(car lst)
lst2 (cadr lst)
)
)
(setq group_Line_segments
(cons Line_segments group_Line_segments)
group_parameter
(cons lst2 group_parameter)
)
)
group_turning_point_2
)
(setq group_Line_segments
(reverse group_Line_segments)
group_parameter
(reverse group_parameter)
)
;;利用参数group_parameter (list T1 T2 adjusted_value) 和group_turning_point 把直线线元加进group_Line_segments 中
(setq i 0
n (length group_Line_segments)
)
;; 把第二个转点至最后一个转点的直线线元加进数组group_Line_segments 中
(setq group_Line_segments
(mapcar
'(lambda
(lst / dist lst2 T_back
T_now T_front Δ U_JD quadrant_ang
U_insert element num Z_start
)
(cond
((/= i (- n 1)) ; 当转点num 不是最后一个转点时
(setq T_now (cadr (nth i group_parameter))
T_back (car (nth i group_parameter))
adjusted_value (caddr (nth i group_parameter))
T_front (car (nth (+ i 1) group_parameter))
lst2 (nth (+ i 1) group_turning_point)
; 线元所对应的转点号
dist (nth 4 (nth 3 lst2))
quadrant_ang (cadr (nth 3 lst2))
Δ (- dist (+ T_now T_front))
;直线线元的长度
num (car (car lst2)) ; 转点号
Z_start (- (+ T_now T_back) adjusted_value)
;线元的起点桩号
)
)
;; 当转点num 是最后一个转点时
((= i (- n 1))
(setq T_now (cadr (nth i group_parameter))
T_back (car (nth i group_parameter))
adjusted_value (caddr (nth i group_parameter))
T_front 0; 最后一个转点的切线长度设置为0
lst2 (nth (+ i 1) group_turning_point)
; 线元所对应的转点号
dist (nth 4 (nth 3 lst2))
quadrant_ang (cadr (nth 3 lst2))
Δ (- dist (+ T_now T_front))
num (car (car lst2)) ; 转点号
Z_start (- (+ T_now T_back) adjusted_value)
;线元的起点桩号
)
)
)
(setq i (+ i 1))
;; 当 Δ 长度大于0.1米时，在该转点处加进直线线元
(if (> Δ 0.1)
(progn
(setq U_JD (cadr lst2)
U_insert (polar U_JD quadrant_ang T_now)
num (car (car lst2))
)
;; 创建直线线元[( 转点号I 3) 0 0 Δ reflex quadrant_ang Z_start U_insert ]
(setq element (list (list num 3)
0
0
Δ
1
quadrant_ang
Z_start
U_insert
)
lst (append lst (list element))
)
)
) ; (if (> Δ 0.1) 函数结束
lst
)
group_Line_segments
)
)
;; 把第一直线线元加进数组 group_Line_segments
(setq lst (car group_turning_point)
dist (nth 4 (nth 3 lst))
quadrant_ang (cadr (nth 3 lst))
U_insert (cadr lst) ; 第一个转点的坐标
num (car (car lst)) ; 第一个线元的转点号
lst (car group_parameter)
T_front (car lst) ; 第二个转点的入口方向切线长度
Δ (- dist T_front)
)
;; 判断第一个线元的转点是否存在
(if (> Δ 0.1)
(progn
(setq element (list (list num 3)
0
0
Δ
1
quadrant_ang
0
U_insert
)
)
(setq group_Line_segments
(append (list (list element)) group_Line_segments)
)
)
)
;; 对线元数组 group_Line_segments 中的起始桩号进行处理，
(if (not Z_road_start)
(setq Z_road_start 0) ; 当线路起始桩号没有定义时，设置为0
)
(setq Z Z_road_start) ; 初始化桩号Z 为路线的起始桩号
(setq group_Line_segments
(mapcar
'(lambda (lst / element lenth)
(setq lst
(mapcar
'(lambda (subset)
(apply '(lambda (x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7)
(list x_0 x_1 x_2 x_3 x_4 x_5 (+ Z x_6) x_7)
)
subset
)
)
lst
)
) ; (mapcar '(lambda (subset) 函数结束
;; 当一个转点的全部线元处理完毕后，对该转点的最后一个线元的结束桩号，赋值给Z
(setq element (last lst)) ; 该转点的最后一个线元
(if (= (cadr (car element)) 2)
(setq lenth (car (nth 3 element)))
; 当最后一个线元是缓和曲线时
(setq lenth (nth 3 element))
)
(setq Z (+ (nth 6 element) lenth))
lst ; 保证输出结果为想要的group_Line_segments 数组
)
group_Line_segments
)
)
;; 对group_turning_point 中的交点，求其交点桩号，病并求其象限角，以转角的一半为切线方向
(setq group_data_JD nil) ; 利用数组group_Line_segments和group_parameter (list T1 T2 adjusted_value) 求解
(setq i 1)
(setq group_data_JD
(mapcar '(lambda (lst / T1 Z Z_JD lst2 U ang JD Δ reflex)
(setq T1 (car lst)
lst2 (nth i group_Line_segments)
Z (nth 6 (car lst2))
; 该交点中的第一个线元的起点桩号
Z_JD (+ Z T1)
reflex (nth 4 (car lst2))
)
(setq lst2 (nth i group_turning_point)
U (cadr lst2)
JD (car (car lst2))
Δ (caddr (nth 3 lst2))
ang (car (nth 3 lst2))
ang (+ (* 0.5 Δ) ang)
)
(setq i (+ i 1))
(list Z_JD U ang JD reflex)
)
group_parameter
)
)
(list group_Line_segments group_data_JD)
)
;; 88888888888 88888888888888 88888888888888888 88888888888888888888
;; 计算线路加宽值8888888888 8888888888888888888 88888888888888888888 88888888888888888888
;;从文件中写入加宽数组，输出数组group_widen 其格式为 ( 转点号 widen 线路加宽值)
(defun write_into_group_widen (/ lst fname f1 group group_widen)
(setq fname (getfiled "\n输入存放线路交点加宽参数的文件" "" "txt" 1))
(if (/= fname nil)
(progn
(setq f1 (open fname
"r"
)
)
(while (setq list_1 (read-line f1))
(setq group (cons list_1 group))
)
(setq group (reverse group))
(setq
group_widen
nil
)
(setq group_widen
(mapcar '(lambda (x)
(read x)
)
group
)
)
(close f1) ;关闭文件fname
) ; progn 函数结束
) ;if (/= fname nil) 函数结束
group_widen
) ; write_into_group_widen 函数结束
;; 88888888888888888888888888888888888 (write_into_group_widen )
;; (setq group_widen (write_into_group_widen))
;; 输入参数线元 Line_segments [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ]
;; mold加宽类型，mold为0时, 绘制普通加宽，mold=1 时，按直线加宽
(defun calculate_Transition-curve_widen
(Z group_widen
Line_segments mold
/ L widen
k k_2 k_3
l_x T_1 T_2
T_3 widen_x lenth
lst Z_end
)
(apply
'(lambda (x_0 x_1 x_2 transition_parameter reflex x_5 Z_start x_7)
(setq I (car x_0) ; 转点的编号
num (cadr x_0) ; 线元在转点中的编号
)
(setq lst (assoc I group_widen)
; 寻找转点I 所对应的加宽值
widen (cadr lst)
)
(if (not widen)
(setq widen 0)
)
(if (or (= num 0)
(= num 2)
)
;; 当线元为缓和曲线时
(progn
(setq lenth (car transition_parameter)
lenth (* lenth 1.0)
Z_end (+ Z_start lenth)
)
(if (and
(>= Z z_start)
(<= Z z_end)
)
(progn
(cond
;; 当线元为进口缓和曲线时
((= num 0)
(setq L (- Z z_start))
)
;; 当线元为出口缓和曲线时
((= num 2)
(setq L (- z_end z))
)
) ; cond 函数结束
(setq k (/ L lenth))
;; 当 mold为0时, 绘制普通加宽，mold=1 时，按直线加宽
(cond
((= mold 0)
(setq k_2 (* (expt k 3) 4)
k_3 (* (expt k 4) 3)
widen_x (* (- k_2 k_3) widen)
)
)
((= mold 1)
(setq widen_x (* k widen))
)
) ; 判断缓和曲线是否为普通或直线加宽的函数结束
)
) ; (if (and (>= Z z_start) (< Z z_end) ) 函数结束
)
) ; 处理缓和曲线线元加宽值的函数结束
(if (= num 1)
;; 当线元为圆曲线时
(progn
(setq lenth (* transition_parameter 1.0)
Z_end (+ Z_start lenth)
)
(if (and
(>= Z z_start)
(<= Z z_end)
)
(setq widen_x widen)
) ; (if (and (>= Z z_start) (< Z z_end) ) 函数结束
)
) ; 处理圆曲线线元加宽值的函数结束
(if (not widen_x)
(setq widen_x 0)
widen_x
)
)
Line_segments
)
) ; calculate_Transition-curve_widen函数结束
;; (calculate_Transition-curve_widen 7530 group_widen Line_segments 0 )
;; (setq group_widen (write_into_group_widen))
;; (setq Line_segments (cadr(nth 2 tang99 ))) (setq mold 0 z 7570 I 25 )
;; 绘图用函数88888 绘图用函数88888 绘图用函数88888 绘图用函数88888 绘图用函数88888 绘图用函数88888 绘图用函数88888
;; 对group_data_out 数组进行标注, Wide 为标注点离中心线的距离 , color 为文字颜色
(defun draw_group_data_out
(group_data_out color Wide
/ group Z_start group
n_point
)
(setq group (mapcar 'cadr group_data_out))
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 62 color)
'(100 . "AcDbPolyline")
(cons 90 (length group))
)
(mapcar '(lambda (U) (cons 10 U)) group)
)
)
(setq n_point (length group_data_out)
Z_start (car (car group_data_out))
)
(if (not Wide)
(setq Wide 8)
)
(mapcar
'(lambda (lst / Z U ang string U_offset U_move)
(setq Z (car lst)
U (cadr lst)
ang (+ (caddr lst)
(* 0.5 pi)
)
)
(setq string (f_zhuanghao Z)
U_offset (polar U ang Wide)
U_move (polar U ang (* Wide 2.2))
)
(if (or (= (rem Z 10) 0)
(= state_label "completely")
)
(progn
(entmakex
(list '(0 . "line")
(cons 62 color)
(cons 10 U)
(cons 11 U_offset)
)
)
;; 对文字的方向角度进行控制，使得其保持在0--180度之内
(if (> ang pi)
(setq ang (- ang pi))
)
(entmake
(list '(0 . "TEXT")
(cons 62 color)
(append '(10) U_move)
(cons 40 3)
(cons '1 string)
(cons 50 ang)
'(72 . 1)
(append '(11) U_move)
'(73 . 2)
)
)
)
)
)
group_data_out
)
)
;; 888888888888 88888888888888888 88888888888888888888
;; 对线元参数group_Line_segments [( 转点号num j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert ]
;; 求出一个新的数组 group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的前后线元编号 i k 取值为0 ，1 ，2 ,3
(defun create_group_transition
(group_Line_segments
/ group_transition
group n_1
n group_i
lst num
)
(setq group (apply 'append group_Line_segments))
;; 为了计算方便，在数组group的头和尾巴各加入一个数组
(setq lst (car (car group))
num (car lst)
lst (list (list num 3))
group (append (list lst) group)
lst (car (last group))
num (car lst)
lst (list (list num 3))
group (append group (list lst))
)
(setq n (length group)
n_1 1
group_i nil
)
(repeat (- n 2)
(setq group_i (cons n_1 group_i))
(setq n_1 (+ n_1 1))
)
(setq group_i (reverse group_i))
(setq group_transition nil)
(mapcar '(lambda (n_1 / lst lst_back lst_front i j k)
(setq lst (nth n_1 group)
j (cadr (car lst))
)
(setq lst_back (nth (- n_1 1) group)
lst_front
(nth (+ n_1 1) group)
)
(setq i (cadr (car lst_back))
k (cadr (car lst_front))
)
(setq group_transition
(cons (list (car lst) (list i j k))
group_transition
)
)
)
group_i
)
(reverse group_transition)
) ; (defun create_group_transition 函数结束
;; (setq group_transition ( create_group_transition group_Line_segments ) )
;; 绘制公路曲线中心线
;; (setq Line_segments (cadr group_Line_segments ) )
;; group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的前后线元编号 i k 取值为0 ，1 ，2 ,3
(defun draw_center_line
(Line_segments group_transition / lst group_transition)
(mapcar
'(lambda
(subset / lst group_Z num Z_start Z_end len group_data_out array
j)
;;去除 [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )]中的第一个元素
(setq array (car subset)
num (cadr array)
subset (cdr subset)
Z_start
(nth 5 subset)
)
(cond
((or (= num 0)
(= num 2)
)
(progn
(setq len (car (caddr subset))
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out
(solve_transition_curve group_Z subset)
)
)
)
((= num 1)
(progn
(setq len (caddr subset)
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out (solve_circular_arc group_Z subset))
)
)
((= num 3)
(progn
(setq len (caddr subset)
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out (solve_straightway group_Z subset))
)
)
)
(setq lst (cadr (assoc array group_transition))
group (mapcar 'cadr group_data_out)
)
(cond
((= (cadr lst) 3) ; 直线线元时
(setq j 1)
)
((= (cadr lst) 1) ;圆曲线线元时
(setq j 2) ; 黄色
)
;; 当缓和曲线时接直线和圆时
((or (equal lst '(3 0 1))
(equal lst '(1 2 3))
)
(setq j 3) ; 绿色
)
;; 当缓和曲线时接缓和曲线和圆时
((or (equal lst '(2 0 1))
(equal lst '(1 2 0))
)
(setq j 6) ; 洋红色
)
;; 当缓和曲线是接圆和圆时
((or (equal lst '(1 0 1))
(equal lst '(1 2 1))
)
(setq j 4) ; 青色
)
(t
(setq j 0)
)
)
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 62 j)
'(100 . "AcDbPolyline")
(cons 90 (length group))
)
(mapcar '(lambda (U) (cons 10 U)) group)
)
)
)
Line_segments
)
)
;; (setq e (entlast)) (command "zoom" "e")
;; (mapcar '(lambda (lst) (draw_center_line lst group_transition ) ) group_Line_segments )
;; 绘制公路曲线左右边线
;; (setq group_turning_point ( create_turning_point_group ) )
;; (setq group_widen (write_into_group_widen))
(defun draw_side_boundary (Width group_widen Line_segments
mold group_transition
/ lst
)
;; (setq Width 5 )
(mapcar ; (setq subset (car (nth 2 Line_segments )) )
'(lambda (subset / lst group_Z num
Z_start Z_end len group_data_out
subset_2 i array color
)
;;去除 [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )]中的第一个元素
(setq array (car subset)
num (cadr array)
subset_2 (cdr subset)
reflex (nth 3 subset_2)
Z_start (nth 5 subset_2)
)
(cond
((or (= num 0)
(= num 2)
)
(progn
(setq len (car (caddr subset_2))
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out
(solve_transition_curve group_Z subset_2)
)
)
)
((= num 1)
(progn
(setq len (caddr subset_2)
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out (solve_circular_arc group_Z subset_2))
)
)
((= num 3)
(progn
(setq len (caddr subset_2)
Z_end (+ Z_start len)
group_Z (create_group_Z Z_start Z_end 1)
)
(setq group_data_out (solve_straightway group_Z subset_2))
)
)
) ; cond 函数结束
;; 求group_Z 中每个桩号的加宽值 , 当边线和转弯的方向一致时加宽
(if (minusp (* reflex Width))
;; 当边线和路线转弯方向不一致时，加宽值设置为0
(setq group
(mapcar
'(lambda (z)
0
)
group_Z
)
)
(setq group
(mapcar
'(lambda (z)
(calculate_Transition-curve_widen
Z
group_widen
subset
mold
)
)
group_Z
)
)
)
;; 利用加宽数组 group 对group_data_out 沿中心线方向进行偏移操作
(setq i 0
group_sideline
nil
)
(mapcar '(lambda (w / lst ang)
(setq lst (nth i group_data_out))
(apply '(lambda (z U quadrant_ang)
(if (minusp Width)
(setq quadrant_ang (+ quadrant_ang pi))
)
(setq ang (+ quadrant_ang (* 0.5 pi))
U (polar U ang (+ w (abs Width)))
)
(setq group_sideline
(cons (list z U quadrant_ang)
group_sideline
)
)
)
lst
)
(setq i (+ i 1))
)
group
)
(setq group_sideline (reverse group_sideline))
(setq lst (cadr (assoc array group_transition))
group (mapcar 'cadr group_data_out)
)
(cond
((= (cadr lst) 3) ; 直线线元时
(setq color 1)
)
((= (cadr lst) 1) ;圆曲线线元时
(setq color 2) ; 黄色
)
;; 当缓和曲线时接直线和圆时
((or (equal lst '(3 0 1))
(equal lst '(1 2 3))
)
(setq color 3) ; 绿色
)
;; 当缓和曲线时接缓和曲线和圆时
((or (equal lst '(2 0 1))
(equal lst '(1 2 0))
)
(setq color 6) ; 洋红色
)
;; 当缓和曲线是接圆和圆时
((or (equal lst '(1 0 1))
(equal lst '(1 2 1))
)
(setq color 4) ; 青色
)
(t
(setq color 0)
)
)
(draw_group_data_out group_sideline color (abs Width))
)
Line_segments
)
)
;; (setq group_Line_segments (car ( create_group_Line_segments group_turning_point 6782.755 )) )
;; (mapcar '(lambda (lst) (draw_side_boundary 3.5 group_widen lst 0 group_transition ) ) group_Line_segments )
;; (setq e (entlast)) (command "zoom" "e")
;; group_Line_segments 结构 [( 转点号I j) R_start R_end transition_parameter reflex quadrant_ang Z_start U_insert )]
;; 对线元集合group_Line_segments 中的起始点进行标注
(defun label_Line_segments
(group_Line_segments group_transition / group group_2 i)
(setq group (apply 'append group_Line_segments))
(mapcar '(lambda (lst / Z quadrant_ang
ang U string string_2 array
U_offset U_move reflex color
)
(setq z (nth 6 lst)
U (nth 7 lst)
quadrant_ang (nth 5 lst)
reflex (nth 4 lst)
array (car lst)
)
;; group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的前后线元编号 i k 取值为0 ，1 ，2 ,3
(setq array (cadr (assoc array group_transition))
array_2 (list (car array) (cadr array))
)
(cond
((equal array_2
'(3 0)
)
(setq string "ZH")
)
((equal array_2
'(3 1)
)
(setq string "ZY")
)
((equal array_2
'(0 1)
)
(setq string "HY")
)
((equal array_2
'(1 0)
)
(setq string "YH")
)
((equal array_2
'(1 2)
)
(setq string "YH")
)
((equal array_2
'(1 3)
)
(setq string "YZ")
)
((equal array_2
'(2 3)
)
(setq string "HZ")
)
((equal array_2
'(2 0)
)
(setq string "HH")
)
((equal array_2
'(2 1)
)
(setq string "HY")
)
(t
(setq string "88")
)
) ; cond 函数结束
(cond
((= (cadr array) 3) ; 直线线元时
(setq color 1)
)
((= (cadr array) 1) ;圆曲线线元时
(setq color 2) ; 黄色
)
;; 当缓和曲线时接直线和圆时
((or (equal array '(3 0 1))
(equal array '(1 2 3))
)
(setq color 3) ; 绿色
)
;; 当缓和曲线时接缓和曲线和圆时
((or (equal array '(2 0 1))
(equal array '(1 2 0))
)
(setq color 6) ; 洋红色
)
;; 当缓和曲线是接圆和圆时
((or (equal array '(1 0 1))
(equal array '(1 2 1))
)
(setq color 4) ; 青色
)
(t
(setq color 0)
)
)
;; 创建标注桩号用的文字符
(setq string_2 (f_zhuanghao Z)
string (strcat string ": " string_2)
)
(setq
ang (+ quadrant_ang
(* (* 0.5 pi) reflex)
)
)
(setq U_offset (polar U ang 28)
U_move (polar U ang 48)
)
(entmakex
(list '(0 . "line")
(cons 62 color)
(cons 10 U)
(cons 11 U_offset)
)
)
;; 对文字的方向角度进行控制，使得其保持在0--180度之内
(if (> ang pi)
(setq ang (- ang pi))
)
(entmake
(list '(0 . "TEXT")
(cons 62 color)
(append '(10) U_move)
(cons 40 3)
(cons '1 string)
(cons 50 ang)
'(72 . 1)
(append '(11) U_move)
'(73 . 2)
)
)
)
group
)
)
;; (label_Line_segments group_Line_segments group_transition )
;; 对group_data_JD (list Z_JD U ang JD reflex ) 数组进行标注
;; (setq lst (create_group_Line_segments group_turning_point 6782.755 )) (setq group_data_JD (cadr lst))
(defun lable_group_turning_point
(group_data_JD group_turning_point / group U)
;; 画出group_turning_point 中的转点
(setq group (mapcar 'cadr group_turning_point))
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
(cons 6 "tang")
(cons 48 8)
'(100 . "AcDbPolyline")
(cons 90 (length group))
)
(mapcar '(lambda (U) (cons 10 U)) group)
)
)
;; 对group_turning_point中的交点用数组group_data_JD 进行桩号标注
(mapcar
'(lambda (lst / string ang U_offset U_move lst2)
(apply '(lambda (Z U quadrant_ang JD reflex)
(setq string (f_zhuanghao Z)
string (strcat "JD" (itoa JD) ": " string)
)
(setq
ang (- quadrant_ang
(* (* 0.5 pi) reflex)
)
U_move (polar U ang 50)
)
;; 对文字的方向角度进行控制，使得其保持在0--180度之内
(if (> ang pi)
(setq ang (- ang pi))
)
(entmake
(list '(0 . "TEXT")
(append '(10) U_move)
(cons 40 3)
(cons '1 string)
(cons 50 ang)
'(72 . 1)
(append '(11) U_move)
'(73 . 2)
)
)
)
lst
)
;; (setq lst ( car group_data_JD ))
)
group_data_JD
)
) ; test_tang_5 函数结束
;; (lable_group_turning_point group_data_JD group_turning_point )
;; 绘图用函数函数结束 88888 绘图用函数函数结束88888 绘图用函数函数结束88888 绘图用函数函数结束88888 绘图用函数函数结束88888 绘图用函数函数结束
;; dcl使用文件 888888888888888888 dcl使用文件 888888888888888888 dcl使用文件 888888888888888888
(setq dialog_tang
'("JD_item:list_box{ key="JD_list"; label="交点参数表："; value=0;"
"list=" ( 转点号转点状态nil) 转点坐标 ( Lh1 R Lh2 ) \\n ( 转点号转点状态t) 转点坐标 (R_start R R_end Lh1 Lh2 )";"
"allow_accept=true;}"
"Line_segments :list_box{ key="Line_segments"; label="线元参数参数表："; value=0;"
"list="( 转点号I j) 起点半径终点半径曲线长度偏转系数线元起点象限角起点桩号起点坐标 ) ";"
"allow_accept=true;}"
"table_wide :list_box{ key="table_wide"; label="交点加宽参数参数表："; value=0;"
"list=" 交点号交点加宽值 ";"
"allow_accept=true;}"
"scfg:toggle{ label="曲线加宽方式,选中为直线加宽,不选普通加宽"; key="scfg";}"
"Z_road_start :edit_box {label="请选择线路起点桩号:"; key= "Z_road_start";value="0";allow_accept=true;}"
"Wide_L :edit_box {label="路线左幅宽度:"; key= "Wide_L";value="5";allow_accept=true;}"
"Wide_R :edit_box {label="路线右幅宽度:"; key= "Wide_R";value="10";allow_accept=true;}"
"insert_table_J :button {label="请选择交点参数列表:"; key= "insert_table_J"; }"
"insert_table_W :button {label="请选择加宽参数列表:"; key= "insert_table_W"; }"
"draw :button {label="绘制曲线:"; key= "draw"; fixed_width=true;width=12;}"
"calculate :button {label="计算线元参数:"; key= "calculate"; }"
"draw_road:"
"dialog{ label="用变换群的方法绘制公路曲线"; spacer;"
"fixed_width=true;"
"width=118;"
": boxed_row {JD_item;"
": column { fixed_width=true;width=20;"
"insert_table_J; spacer; calculate ; }"
"}"
"Line_segments ;"
": boxed_row { table_wide ;"
": column{ fixed_width=true;width=50;"
"scfg ; insert_table_W ;"
"Z_road_start ; Wide_L ; Wide_R ;"
"}"
"}"
": boxed_row { ok_cancel; draw; }"
"}"
)
)
(defun Dcl_write (lst / dcl_file str file)
(vl-load-com)
(setq dcl_file (vl-filename-mktemp nil nil ".dcl"))
(setq file (open dcl_file "w"))
(foreach str lst (write-line str file))
(close file)
(setq id (load_dialog dcl_file))
)
(defun C:use_dcl (/ id sdt
group_turning_point group_Line_segments
group_Line_segments group_widen
W_L W_R mold
)
(if nil
(setq ID
(load_dialog
"D:\\工作文件\\新建文件夹\\work\\公路曲线简易程序\\绘制公路曲线"
)
)
(Dcl_write dialog_tang)
)
;; 创建一个绘制交点直线的线性
(if (not (tblobjname "LTYPE" "tang"))
(entmake
(list '(0 . "LTYPE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLinetypeTableRecord")
(cons 2 "tang") ; 线形名
'(3 . "点画线 ____ ____ ____") ; 线型的说明文字
'(70 . 0) ;标准标记值（按位编码值）
'(73 . 2) ;线型元素的数目
'(40 . 20.0) ; 图案总长度
'(49 . 15.0) ; 虚线、点或空间长度（每个元素一个条目）
'(74 . 0) ; 复杂线型元素类型（每个元素一种类型）。默认值为 0（无嵌入的形/文字）
'
(49 . -5.0)
'(74 . 0)
'(46 . 50)
)
)
)
(if (not (new_dialog "draw_road" id))
(exit)
)
(setq sdt 1)
(while (> sdt 0)
(action_tile
"insert_table_J"
"(action_insert_table_J) "
)
(action_tile
"calculate"
"(action_calculate) "
)
(action_tile
"insert_table_W"
"(action_insert_table_W) "
)
(action_tile
"draw"
"(action_draw)(done_dialog -8 )"
)
(setq sdt (start_dialog))
)
(unload_dialog id)
(if (= sdt -8)
(progn
(if group_Line_segments
(progn
(setq group_transition
(create_group_transition
group_Line_segments
)
)
(mapcar '(lambda (lst) (draw_center_line lst group_transition))
group_Line_segments
)
(mapcar
'(lambda (lst)
(draw_side_boundary
W_L group_widen lst mold group_transition)
)
group_Line_segments
)
(mapcar
'(lambda (lst)
(draw_side_boundary
W_R group_widen lst mold group_transition)
)
group_Line_segments
)
(label_Line_segments group_Line_segments group_transition)
)
)
(if (and group_data_JD group_turning_point)
(lable_group_turning_point
group_data_JD
group_turning_point
)
)
(setq e (entlast))
(command "zoom" "e")
)
) ; (if (= sdt 8) 函数结束
)
;; (setq e (car (entsel "pick a object :" ))) (setq tang (entget e ) )
(defun action_calculate (/ lst group road_start group_sum n)
(setq road_start (get_tile "Z_road_start")
road_start (atof road_start)
)
(if group_turning_point
(progn
(setq
lst
(create_group_Line_segments group_turning_point road_start)
group_Line_segments
(car lst)
group_data_JD
(cadr lst)
group_sum (apply 'append group_Line_segments)
)
;; 用 group_Line_segments 填充列表框 "Line_segments"
(setq group_sum
(mapcar ; (setq lst (car group_sum)) (setq x_7 ( nth 7 lst))
'(lambda (lst / lenth lst_label)
(apply '(lambda (x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7)
(setq x_0 (mapcar 'itoa x_0)
x_0 (list (car x_0) "-" (cadr x_0))
x_0 (apply 'strcat x_0)
)
(setq x_7 (mapcar 'rtos x_7)
x_7 (list "N:" (cadr x_7) " E:" (car x_7))
x_7 (apply 'strcat x_7)
)
(setq
x_6 (f_zhuanghao x_6)
)
(if (atom x_3)
(setq lenth x_3)
(setq lenth (car x_3))
)
(setq lenth (* lenth 1.0)
x_3 (rtos lenth 2 2)
x_5 (angtos x_5 1 6)
)
;; 对(list x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7 ) 进行标注
(setq lst (list x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7)
lst_label (list "R_s:"
"R_e:"
"lenth:"
"reflex:"
"α_s:"
)
lst (append lst lst_label)
)
;; lst顺序为 (0 1 2 3 4 5 6 7 8 9 10 11 12 )
(mapcar '(lambda (i)
(nth i lst)
)
(list 0 8 1 9 2 10 3 11 4 12 5 6 7)
)
)
lst
)
)
group_sum
)
)
(setq group ; (setq lst (car group_sum ))
(mapcar '(lambda (lst / string)
(setq string (vl-princ-to-string lst))
(setq string (vl-string-left-trim "\(" string)
string (vl-string-right-trim "\)" string)
)
)
group_sum
)
)
(start_list "Line_segments" 3)
(mapcar 'add_list group)
(end_list)
(setq n (length group))
(set_tile "Line_segments" (itoa n))
)
;; 当group_turning_point 数组为空时
(progn
(start_list "Line_segments" 2)
(mapcar 'add_list (list "您还没有输入交点数组!"))
(end_list)
(setq n (length group))
(set_tile "Line_segments" (itoa n))
)
)
) ; action_calculate 函数结束
(defun action_insert_table_W (/ lst group)
(setq group_widen (write_into_group_widen))
;; 用group_widen 数组分别对列表框 "table_wide" 进行填充
(setq group
(mapcar '(lambda (lst
/
JD
W
)
(setq JD (itoa (car lst))
W (rtos (cadr lst) 2 3)
)
(strcat "JD: " JD " 加宽:" W)
)
group_widen
)
)
(start_list "table_wide" 3)
(mapcar 'add_list group)
(end_list)
) ; action_insert_table_W 函数结束
;; 定义插入交点文件按钮的函数
(defun action_insert_table_J (/ lst group)
(setq group_turning_point (create_turning_point_group))
;; 用group_turning_point 数组分别对列表框 "JD_list"
;; 用group_turning_point 数组分别对列表框 "JD_list"
(setq group
(mapcar
'(lambda (lst / state subset_label)
(apply '(lambda (x_0 x_1 x_2 x_3)
(setq x_1 (mapcar 'rtos x_1)
x_1 (list "N:" (cadr x_1) " E:" (car x_1))
x_1 (apply 'strcat x_1)
)
(if (cadr x_0)
(progn
(setq state "Yes")
(setq
x_2 (apply '(lambda (y_0 y_1 y_2 y_3 y_4)
(setq subset_label (list "R_s"
"R"
"R_e"
"Lh1"
"Lh2")
subset (list y_0 y_1 y_2 y_3 y_4)
subset (append subset subset_label)
)
(mapcar '(lambda (i)
(nth i subset)
)
(list 5 0 6 1 7 2 8 3 9 4)
)
)
x_2
)
)
)
(progn
(setq state "No")
(setq x_2 (apply '(lambda (y_0 y_1 y_2)
(setq subset_label (list "Lh1" "R" "Lh2")
subset (list y_0 y_1 y_2)
subset (append subset subset_label)
)
(mapcar '(lambda (i)
(nth i subset)
)
(list 3 0 4 1 5 2)
)
)
x_2
)
)
)
) ; (if (cadr x_0) 函数结束
(setq x_2 (vl-princ-to-string x_2)
x_2 (vl-string-left-trim "\(" x_2)
x_2 (vl-string-right-trim "\)" x_2)
)
(list "JD:" (car x_0) state x_1 x_2)
)
lst
)
)
group_turning_point
)
)
(setq group
(mapcar '(lambda (lst / string)
(setq string (vl-princ-to-string lst)
string (vl-string-left-trim "\(" string)
string (vl-string-right-trim "\)" string)
)
)
group
)
)
(start_list "JD_list" 3)
(mapcar 'add_list group)
(end_list)
) ; action_insert_table_J 函数结束
;; 定义绘图按钮draw 的函数
(defun action_draw (/)
(setq W_L (get_tile "Wide_L")
W_L (atof W_L)
W_R (get_tile "Wide_R")
W_R (* (atof W_R) -1.0)
mold (get_tile "scfg")
mold (atoi mold) ; 加宽方式
)
)
;; (setq e (entlast)) (command "zoom" "e")

;;对一个二维点集合group_point 绕 点center 旋转 ang 弧度 
(defun rotate_group_point (group_point ang center / lst) 
 
 
  (setq        group_point 
         (mapcar '(lambda (point) 
                    (list (- (car point) (car center)) 
                          (- (cadr point) (cadr center)) 
                    ) 
                  ) 
                 group_point 
         ) 
  ) 
  (setq        lst (list (list (cos ang) (* (sin ang) -1)) 
                  (list (sin ang) (cos ang)) 
            ) 
  ) 
  (setq        group_point 
         (mapcar '(lambda (point) 
                    (apply '(lambda (element_1 element_2) 
                              (list (+ (* (car element_1) (car point)) 
                                       (* (cadr element_1) (cadr point)) 
                                    ) 
                                    (+ (* (car element_2) (car point)) 
                                       (* (cadr element_2) (cadr point)) 
                                    ) 
                              ) 
                            ) 
                           lst 
                    ) 
                  ) 
                 group_point 
         ) 
  ) 
  (setq 
    group_point 
     (mapcar '(lambda (x) 
                (list (+ (car x) (car center)) 
                      (+ (cadr x) (cadr center)) 
                ) 
              ) 
             group_point 
     ) 
  ) 
) 
;; 8888888888888888  88888888888888888888888  88888888888888888    
 
;;定义一个队group_data_out 数组进行群变换的函数 ，group_data_out 结构为：(Z_桩号 U ang_象限角 )   
;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度 
(defun transformation_group_data_out 
                                     (group_data_out 
                                      reflex           data_origin 
                                      data_insert  / 
                                      group_point  quadrant_ang 
                                      ang_Δ           ang 
                                      U_origin           U_insert 
                                      group           i 
                                     ) 
 
  (setq group (append (list data_origin) group_data_out)) 
  (if (= reflex -1) 
    (setq group 
           (mapcar '(lambda (lst / Z U ang) 
                      (setq Z        (car lst) 
                            U        (cadr lst) 
                            ang        (caddr lst) 
                      ) 
                      (list Z 
                            (list (car U) 
                                  (* (cadr U) -1) 
                            ) 
                            (* ang -1) 
                      ) 
                    ) 
                   group 
           ) 
    ) 
  )                                        ; (if (= reflex -1) 函数结束 
  (setq        data_origin    (car group) 
        group_data_out (cdr group) 
 
  ) 
  ;; 对group_data_out 数组进行平移,使得原坐标系中的U_origin点，和实际线元的起点U_insert向符合 
  (setq        U_origin (cadr data_origin) 
        U_insert (cadr data_insert) 
  ) 
  (setq        group_data_out 
         (mapcar '(lambda (lst / Z U x y ang) 
                    (setq Z   (car lst) 
                          U   (cadr lst) 
                          x   (+ (- (car U) (car U_origin)) 
                                 (car U_insert) 
                              ) 
                          y   (+ (- (cadr U) (cadr U_origin)) 
                                 (cadr U_insert) 
                              ) 
                          ang (caddr lst) 
                    ) 
                    (list Z (list x Y) ang) 
                  ) 
                 group_data_out 
         ) 
  ) 
  ;; 对 group_data_out 数组,以线元的起点U_insert进行旋转 quadrant_ang- ang 角度操作 
  (setq        ang             (caddr data_origin) 
        quadrant_ang (caddr data_insert) 
  ) 
 
  (setq        group_point 
         (mapcar 'cadr group_data_out) 
  ) 
  (setq        ang_Δ            (- quadrant_ang ang) 
        group_point (rotate_group_point group_point ang_Δ U_insert) 
  ) 
  (setq        i 0 
        group_data_out 
         (mapcar '(lambda (lst / U ang) 
                    (setq U   (nth i group_point) 
                          ang (caddr lst) 
                          i   (+ i 1) 
                    ) 
                    (list (car lst) U (+ ang ang_Δ)) 
 
                  ) 
                 group_data_out 
         ) 
  ) 
)                                        ; (defun transformation_group_data_out 函数结束 
;; (transformation_group_data_out group_data_out reflex         data_origin  data_insert)    
 
 
 
 
 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888   
;;  人口变量, 缓和曲线参数A,  缓和曲线长L   
(defun solve_transition_curve_sub (A               L           / 
                                   group       U           deflection 
                                   functon_parameter 
                                  ) 
  ;; (setq L 40.0 A 200 )    
  (if (> L 0.000001) 
    (progn 
      (setq L (* L 1.0) 
            A (* A 1.0) 
      ) 
      (setq functon_parameter 
             '(((1 0 1.0 1) 
                (5 4 40.0 -1) 
                (9 8 3456.0 1) 
                (13 12 599040.0 -1) 
                (17 16 1.75473e+007 1) 
               ) 
               ((3 2 6.0 1) 
                (7 6 336.0 -1) 
                (11 10 42240.0 1) 
                (15 14 9.6768e+006 -1) 
                (19 18 3.5301e+009 1) 
               ) 
              ) 
      ) 
      ;; 把 L A 带入函数 进行求值   
      (setq group 
             (mapcar '(lambda (subset) 
                        (mapcar        '(lambda (lst) 
                                   (apply '(lambda (a_1 a_2 a_3 a_4) 
                                             (*        (/ (expt L a_1) 
                                                   (* (expt A a_2) a_3) 
                                                ) 
                                                a_4 
                                             ) 
                                           ) 
                                          lst 
                                   ) 
                                 ) 
                                subset 
                        ) 
                      ) 
                     functon_parameter 
             ) 
      ) 
 
      (setq U 
             (mapcar '(lambda (subset) 
                        (apply '+ subset) 
                      ) 
                     group 
             ) 
      ) 
 
      (setq deflection 
             (/ (expt L 2.0) (* (expt A 2.0) 2.0)) 
      )                                        ;  J为弧度 
      (list U deflection) 
    )                                        ; progn函数结束 
    ;; 当缓和曲线长L很小时 
    (list '(0 0) 0) 
  )                                        ;  if 函数结束 
) 
;;  输出参数为切线支距坐标复数U,偏角deflection   
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888 
 
 
 
;; 当线元是缓和曲线时， subset 数据结构为 
;;  ( R_start R_end  transition_parameter    reflex         quadrant_ang    Z_start  U_insert )    
(defun solve_transition_curve (group_Z           subset      / 
                               A           Lh               lst 
                               Lh_start           Lh_end      U_Z_start 
                               β_start           Z_end       group_data_out 
                               data_origin data_insert 
                              ) 
  (apply 
    '(lambda (R_start              R_end              transition_parameter 
              reflex              quadrant_ang    Z_start 
              U_insert 
             ) 
 
       (setq Lh             (car transition_parameter) ; 缓和曲线长度   
             A             (cadr transition_parameter) ; 缓和曲线参数 
             R_start (* R_start 1.0) 
             R_end   (* R_end 1.0) 
       ) 
       (if (= R_start 0) 
         (setq R_start (expt 10.0 30)) 
       ) 
       (if (= R_end 0) 
         (setq R_end (expt 10.0 30)) 
       ) 
       (if (> R_start R_end) 
         ;; 正向缓和曲线时   
         (progn 
           (setq Lh_start  (/ (expt A 2) R_start) ; 起点缓和曲线长度 
                 lst           (solve_transition_curve_sub A Lh_start) 
                 U_Z_start (car lst)        ; 缓和曲线的起点切线支距坐标 
                 β_start  (cadr lst)        ;缓和曲线起点象限角 
           ) 
           ;; 对桩号集合group_Z 进行操作 
           (setq group_data_out 
                  (mapcar '(lambda (z / L lst U_Z β_Z) 
                             (setq L (+ (- Z Z_start) Lh_start)) 
                             (setq lst        (solve_transition_curve_sub A L) 
                                   U_Z        (car lst) 
                                   β_Z        (cadr lst) 
                             ) 
                             (list Z U_Z β_Z) 
                           ) 
                          group_Z 
                  ) 
           ) 
         ) 
         ;; 反向缓和曲线时   
         (progn 
           (setq Lh_start  (/ (expt A 2) R_start) 
                 lst           (solve_transition_curve_sub A Lh_start) 
                 U_Z_start (car lst) 
                 β_start  (cadr lst) 
           ) 
           (setq Lh_end        (/ (expt A 2) R_end) ; 终点缓和曲线长度 
                 Z_end        (+ Z_start Lh) 
           ) 
           (setq group_data_out 
                  (mapcar '(lambda (z / L lst U_Z β_Z) 
                             (setq L (+ (- Z_end Z) Lh_end)) 
                                        ; 加桩点的缓和曲线长度，从完整缓和曲线的起点算起 
                             (setq lst        (solve_transition_curve_sub A L) 
                                   U_Z        (car lst) 
                                   β_Z        (cadr lst) 
                             ) 
                             (list Z U_Z β_Z) 
                           ) 
                          group_Z 
                  ) 
           ) 
           ;;此时生成的group_data_out与标准的正向缓和曲线线(原点0，启始方位角0，右手螺旋坐标系) 沿着X轴对称 ， 
           ;;所以要对group_data_ou 进行沿x轴镜像   
           (setq group_data_out 
                                (mapcar        '(lambda (lst / Z U ang) 
                                           (setq Z   (car lst) 
                                                 U   (cadr lst) 
                                                 ang (caddr lst) 
                                           ) 
                                           (list Z 
                                                 (list (* (car U) -1) 
                                                       (cadr U) 
                                                 ) 
                                                 (* ang -1) 
                                           ) 
                                         ) 
                                        group_data_out 
                                ) 
 
                 U_Z_start 
                                (list (* (car U_Z_start) -1) 
                                      (cadr U_Z_start) 
                                ) 
 
                 β_start 
                                (* β_start -1) 
           ) 
         ) 
 
       )                                ; (if (> R_start R_end)  函数结束   
       ;; 创建transformation_group_data_out 函数用参数   data_origin  data_insert   
       (setq data_origin (list 0 U_Z_start β_start) 
             data_insert (list 0 U_insert quadrant_ang) 
       ) 
       ;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度 
       (transformation_group_data_out 
         group_data_out 
         reflex 
         data_origin 
         data_insert 
       ) 
     ) 
    subset 
  ) 
) 
;;88888888888888888888888888888888888888888888888888888888888888888   (expt 10.0 30)    
 
 
 
 
 
 
 
 
 
 
;; 当线元是圆曲线时 subset 数据结构为 
;;  ( R_start R_end  lenth    reflex         quadrant_ang    Z_start  U_insert   )    
(defun solve_circular_arc (group_Z         subset               / 
                           i                 group_data_out 
                           U_center         data_origin   data_insert 
                          ) 
 
 
  ;; (tang_test   group_data_out )    
  (apply 
    '(lambda (R_start R_end lenth reflex quadrant_ang Z_start U_insert) 
 
       ;; 设定圆曲线圆心为原点(0 R_start)，方向为 右手坐标系，圆曲线线起点坐标(0   0 ),切线为X轴 
 
       (setq R_start  (* R_start 1.0) 
             U_center (list 0 R_start) 
       ) 
       (setq group_data_out 
              (mapcar '(lambda (Z / L β U_Z ang) 
                         (setq L   (- Z Z_start) 
                               β  (/ L R_start) 
                               ang (- β (/ pi 2)) 
                               U_Z (polar U_center ang R_start) 
                         ) 
                         (list Z U_Z β) 
                       ) 
                      group_Z 
              ) 
       ) 
       ;; 创建transformation_group_data_out 函数用参数   data_origin  data_insert   
       (setq data_origin (list 0 (list 0 0) 0) 
             data_insert (list 0 U_insert quadrant_ang) 
       ) 
       ;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度 
       (transformation_group_data_out 
         group_data_out 
         reflex 
         data_origin 
         data_insert 
       ) 
     ) 
    subset 
  ) 
) 
;;88888888888888888888888888888888888888888888888888888888888888888   
 
 
 
 
 
;; 当线元是直线时 subset 数据结构为 
;;  ( R_start R_end  lenth    reflex         quadrant_ang    Z_start  U_insert   )    
(defun solve_straightway 
                         (group_Z subset / group_data_out) 
 
  ;; (tang_test   group_data_out )    
  (apply 
    '(lambda (R_start R_end lenth reflex quadrant_ang Z_start U_insert) 
       (setq group_data_out 
              (mapcar '(lambda (Z / L U_Z) 
                         (setq L   (- Z Z_start) 
                               U_Z (polar U_insert quadrant_ang L) 
                         ) 
                         (list Z U_Z quadrant_ang) 
                       ) 
                      group_Z 
              ) 
       ) 
     ) 
    subset 
  ) 
) 
;;88888888888888888888888888888888888888888888888888888888888888888   
 
 
 
 
;; 创建一个 桩号的函数   
(defun create_group_Z (Z_start Z_end Z_Δ / lst group_Z z) 
 
  (setq        group_z        (list Z_start) 
        Z        (+ (fix Z_start) 1) 
  ) 
  (while (< Z Z_end) 
    (setq group_Z (cons z group_Z)) 
    (setq z (+ z Z_Δ)) 
  ) 
  (setq        group_z 
         (reverse group_z) 
  ) 
  (append group_z (list Z_end)) 
) 
;; (setq  group_Z ( create_group_Z 10784.9 10834 1)  )   
 
 
 
 
 
 
 
(defun f_zhuanghao (Z / 桩号1 桩号2 Z_1 z_2 z_3 桩号3 桩号) 
  (setq        Z_1 (fix Z) 
        Z_2 (rem Z_1 1000)                ;整数桩号 
        Z_3 (/ (- Z_1 Z_2) 1000)        ;公里桩号 
        Z_4 (- Z Z_1)                        ;小数桩号 
  ) 
  (setq        桩号1 (itoa Z_3)                ;获得整公里桩号 
        桩号2 (itoa Z_2)                ;获得桩号的小里程数 
        桩号3 (substr (rtos Z_4 2 3) 2 4) ;获得桩号的小数   
  ) 
  (cond 
    ((and (= Z_2 0) (= Z_4 0)) 
     (setq 桩号 (strcat "K" 桩号1 "+000")) 
                                        ; 获得桩号的字符表达式如"K3+000" 的形式 
    ) 
    ((and (= (rem Z_2 10) 0) (= Z_4 0)) 
     (setq 桩号 (strcat "+" 桩号2)) 
                                        ; 获得桩号的字符表达式如"+860" 的形式 
    ) 
    (t (setq 桩号 (strcat "K" 桩号1 "+" 桩号2 桩号3))) 
  ) 
)                                        ;zhuanghao函数结束 
;;8888888888888888888888888888888888888888888888 
 
 
 
;; 交点参数的文件格式, 当交点为完整缓和曲线时 :  [ ( 转点号I nil)   U_转点  ( Ls1 R Ls2 )  ] ， 
;; 当交点为非完整缓和曲线交点时 :   [ ( 转点号I t)  U_转点   ( R_start  R  R_end  Ls1   Ls2) ]   
;; 输出变量turning_point_group : [ ( 转点号I nil)   U_转点  ( Ls1 R Ls2 )(α1  α2   Δ Dist_1   Dist_2 )]    
(defun create_turning_point_group 
                                  (/            n             i              lst 
                                   fname    group    turning_point_group 
                                   f1 
                                   ;; 求交点距离角度时用到的参数   
                                   α1            α2             Δ              Dist_1 
                                   Dist_2   lst_1    lst_2    lst_3 
                                   U_1            U_2             U_3 
                                  ) 
  ;; turning_point_group 格式 [ ( 转点号I nil)   U_转点  ( Ls1 R Ls2 )  ]  , 完整缓和曲线时   
  ;;  or [ ( 转点号I nil)  U_转点   ( R_start R  R_end  Ls1   Ls2) ]  , 非完整缓和曲线交点时    
  (setq fname (getfiled "输入存放交点参数的文件" "" "txt" 1)) 
  (setq f1 (open fname "r")) 
  (setq group nil) 
  (while (setq lst (read-line f1)) 
    (setq group (cons lst group)) 
  )                                        ; while (/= list  nil)循环函数结束 
  (close f1) 
  (setq        i 0 
        group_turning_point 
         nil 
        n (length group) 
  ) 
  (repeat n 
    (setq lst                      (read (nth i group)) 
          group_turning_point 
                              (cons lst group_turning_point) 
    ) 
    (setq i (+ i 1)) 
  ) 
  (setq        group_turning_point 
         (vl-sort group_turning_point 
                  '(lambda (lst1 lst2) 
                     (<        (car (car lst1)) 
                        (car (car lst2)) 
                     ) 
                   ) 
 
         ) 
  ) 
  ;; 对数组group_turning_point  [ ( 转点号I nil)  U_转点 ( Ls1 R Ls2 )  ] ， 加入第三项 (α1  α2   Δ Dist_1   Dist_2 )   
  (setq        i 0 
        group nil 
  ) 
  (repeat n 
    (cond 
      ;;当转点为[第二个->倒数第二个] 转点时   
      ((and (/= i 0) (/= i (- n 1))) 
       (progn 
         (setq lst_1 (nth (- i 1) group_turning_point)) 
         (setq lst_2 (nth i group_turning_point)) 
         (setq lst_3 (nth (+ i 1) group_turning_point)) 
         (setq U_1 (cadr lst_1) 
               U_2 (cadr lst_2) 
               U_3 (cadr lst_3) 
         ) 
         (setq Dist_1 (distance U_1 U_2) 
               Dist_2 (distance U_2 U_3) 
         ) 
         (setq α1 (angle U_1 U_2) 
               α2 (angle U_2 U_3) 
               Δ  (- α2 α1) 
         ) 
         ;; 对转角Δ 使其控制在(-pi pi) 之间 
         (cond 
           ((and (>= Δ (* -1 pi)) 
                 (< Δ pi) 
            ) 
            (setq Δ Δ) 
           ) 
           ((< Δ (* -1 pi)) 
            (setq Δ (+ Δ (* 2 pi))) 
           ) 
           ((> Δ pi) 
            (setq Δ (- Δ (* 2 pi))) 
           ) 
         ) 
         (setq lst   (list α1 α2 Δ Dist_1 Dist_2) 
               lst   (append lst_2 (list lst)) 
               group (cons lst group) 
         ) 
       ) 
      ) 
      ;;当为第一个转点时的情形 起始转点->下一转点 
      ((= i 0) 
       (progn 
         (setq lst_2 (nth i group_turning_point)) 
         (setq lst_3 (nth (+ i 1) group_turning_point)) 
         (setq 
           U_2 (cadr lst_2) 
           U_3 (cadr lst_3) 
         ) 
         (setq Dist_1 0 
               Dist_2 (distance U_2 U_3) 
               α2    (angle U_2 U_3) 
               lst    (list 0 α2 0 0 Dist_2) 
         ) 
         (setq lst   (append lst_2 (list lst)) 
               group (cons lst group) 
         ) 
       ) 
      ) 
      ;; 当转点为最后一个转点时的情形 上一转点->终点转点    
      ((= i (- n 1)) 
       (progn 
         (setq lst_1 (nth (- i 1) group_turning_point)) 
         (setq lst_2 (nth i group_turning_point)) 
         (setq U_1 (cadr lst_1) 
               U_2 (cadr lst_2) 
         ) 
         (setq Dist_1 (distance U_1 U_2) 
               α1    (angle U_1 U_2) 
 
               lst    (list α1 0 0 Dist_1 0) 
         ) 
         (setq lst   (append lst_2 (list lst)) 
               group (cons lst group) 
         ) 
       ) 
      ) 
    )                                        ; cond  函数结束   
    (setq i (+ i 1)) 
  )                                        ; (repeat n  函数结束 
  (setq group_turning_point (reverse group)) 
 
                                        ; 排序函数结束 
)                                        ;  create_turning_point_group_2 函数结束   
;; (setq group_turning_point ( create_turning_point_group )  )    
 
 
 
 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888   
;;  人口变量缓和曲线长Lh, 缓和曲线半径R，  出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A    
(defun evaluation_transition_curve 
                                   (Lh              R                / 
                                    A              p                q 
                                    β              group 
                                    functon_parameter 
                                   ) 
  ;; (setq lh 50 r 480 )   
  (setq        R  (* 1.0 R) 
        Lh (* 1.0 Lh) 
  ) 
  (setq        functon_parameter 
         '(((2 1 24.0) 
            (4 3 -2688.0) 
            (6 5 506880.0) 
            (8 7 -1.54829e+008) 
           ) 
           ((1 0 2.0) 
            (3 2 -240.0) 
            (5 4 34560.0) 
            (7 6 -8.38656e+006) 
            (9 8 3.15851e+009) 
           ) 
          ) 
  ) 
  ;;把参数parameter_easement_curve  带入求值， 
  (setq        group 
         (mapcar '(lambda (subset) 
                    (mapcar '(lambda (lst) 
                               (apply '(lambda (a_1 a_2 a_3) 
                                         (/ (expt Lh a_1) 
                                            (* (expt R a_2) a_3) 
                                         ) 
                                       ) 
                                      lst 
                               ) 
                             ) 
                            subset 
                    ) 
                  ) 
                 functon_parameter 
         ) 
  ) 
  (setq        group 
         (mapcar '(lambda (subset) 
                    (apply '+ subset) 
                  ) 
                 group 
         ) 
  ) 
  (setq        p  (car group) 
        q  (cadr group) 
        β (/ Lh (* R 2.0)) 
        A  (sqrt (* R Lh)) 
  ) 
  ;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A    
  (list p q β A) 
)                                        ;   evaluation_easement_curve 函数结束                                  
;;  (evaluation_transition_curve  50  480  )  (evaluation_transition_curve   50  480  )                           
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888 
 
 
 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888 
;; (setq group_turning_point ( create_turning_point_group )  )    
;; 求基本对称路线平曲线的 曲线要素 入口变量: [ ( 转点号I nil)   U_转点  ( Lh R  Lh  )(α1  α2   Δ Dist_1   Dist_2 )]   
;; 出口变量:该转点各线元的数据[( 转点号I j)   R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert )  ]    
(defun evaluation_symmetrical_curve (subset / Z_I U group_data_out) 
  ;; (setq subset (nth 15   group_turning_point )) 
  (setq        Z_I    (car (car subset))        ; 转点编号 
        subset (cdr subset) 
  ) 
  ;; (setq U_ZD_real (car subset) lst1  (cadr subset) lst2  (caddr subset) )    
  (apply '(lambda (U_ZD_real             lst1     lst2     / 
                   ;; 计算交点用参数 
                   quadrant_ang             Δ 
                   ;; 计算切线长度 T1 T2 所用参数 
                   T1            T2             a_1      a_2      tangent 
                   cscΔ    cotΔ 
                   ;; 计算缓和曲线的内蕴参数 
                   parameter             Lh1      Lh2      R 
                   A1            A2             p1              p2       q1 
                   q2            β1             β2      βy      E 
                   Ly            L             adjusted_value    reflex 
                   ;; 建立线元坐标系所用参数 
                   U_center U_JD     U_ZH     U_HY     U_QZ 
                   U_YH            U_HZ 
                   ;; 桩号用参数 
                   Z_JD            Z_ZH     Z_HY     Z_QZ     Z_YH 
                   Z_HZ 
                   ;; 切线角用参数   
                   ang_JD   ang_ZH   ang_HY   ang_QZ   ang_YH 
                   ang_HZ 
                   ;; 对数组 group_data_out 进行移位，镜像，旋转 用参数 
                   quadrant_ang             data_origin       data_insert 
                   ;;创建线元列表所用参数   
                   lst            lst2     lst3     lst4     Line_segments 
                  ) 
            (setq Lh1               (car lst1) 
                  R               (cadr lst1) 
                  Lh2               (caddr lst1) 
                  quadrant_ang 
                               (car lst2) ; 设计交点的入口方位角   
                  Δ               (caddr lst2) ; 设计交点偏转系数 
 
            ) 
            (if        (>= Δ 0) 
              (setq reflex 1) 
              (setq reflex -1 
                    Δ           (* -1 Δ) 
              ) 
            ) 
            (setq 
              parameter 
                        (evaluation_transition_curve Lh1 R) 
              ;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A    
              p1        (car parameter) 
              q1        (cadr parameter) 
              β1        (caddr parameter) 
              A1        (nth 3 parameter) 
            ) 
            (cond 
              ((= Lh1 Lh2) 
               (setq 
                 β2 β1 
                 A2  A1 
               ) 
               (setq tangent (/ (sin (/ Δ 2)) (cos (/ Δ 2))) 
                     T1             (+ (* (+ R p1) tangent) q1) 
                     T2             T1 
                                        ; 切线长度 
               ) 
              ) 
              ;; 当出口、进口缓和曲线长度不相等时 
              ((/= Lh1 Lh2) 
               (setq 
                 parameter 
                           (evaluation_transition_curve Lh2 R) 
                 ;; 出口变量缓和曲线出口段内移值p,切线增量q ,偏角β,缓和曲线参数A    
                 p2           (car parameter) 
                 q2           (cadr parameter) 
                 β2           (caddr parameter) 
                 A2           (nth 3 parameter) 
               ) 
               (setq cscΔ (/ 1.0 (sin Δ)) 
                     cotΔ (/ (cos Δ) (sin Δ)) 
                     a_1   (* (+ R p2) cscΔ) 
                     a_2   (* (+ R p1) cotΔ) 
                     T1           (+ (- a_1 a_2) 
                              q1 
                           ) 
                     a_1   (* (+ R p1) cscΔ) 
                     a_2   (* (+ R p2) cotΔ) 
                     T2           (+ (- a_1 a_2) 
                              q2 
                           ) 
               ) 
              ) 
            )                                ; (cond  函数 结束 
            (setq a_1                 (expt (+ R p1) 2) 
                  a_2                 (expt (- T1 q1) 2) 
                  E                 (- (sqrt (+ a_1 a_2)) R) ; 外距 
                  βy                 (- Δ (+ β1 β2)) 
                  Ly                 (* βy R) 
                                        ; 圆曲线长度 
                  L                 (+ Ly (+ Lh1 Lh2)) 
                  adjusted_value (- (+ T1 T2) L) ; 切曲差   
            ) 
            ;; 以ZH点为坐标原点，该点的切线方向为X轴，建立右手螺旋坐标系 ,转角 Δ取正数    
            ;;转点的桩号 Z_JD = z_QZ + adjusted_value 
            (setq ang_JD (/ Δ 2) 
                  ;; 设置为U_JD ->U_center的垂直方向 
                  ang_ZH 0 
                  ang_HY β1 
                  ang_QZ (+ β1 (/ βy 2)) 
                  ang_YH (- Δ β2) 
                  ang_HZ Δ 
            ) 
            ;;   (angtos   (+(/ (- pi Δ) 2)Δ)   1 6  )    
            (setq 
              U_JD     (list T1 0) 
              U_center (list q1 (+ R p1)) 
              U_ZH     (list 0 0)        ;向量U_center ->U_JD 的方位角 (+ (/ Δ 2)pi)    
              U_HY     (polar U_center (- ang_HY (* pi 0.5)) R) 
              U_QZ     (polar U_center (- ang_QZ (* pi 0.5)) R) 
              U_YH     (polar U_center (- ang_YH (* pi 0.5)) R) 
              U_HZ     (polar U_JD Δ T2) 
            ) 
            (setq Z_JD T1 
                  Z_ZH 0 
                  Z_HY Lh1 
                  Z_QZ (+ Lh1 (/ Ly 2)) 
                  Z_YH (+ Lh1 Ly) 
                  Z_HZ L 
            ) 
            (setq group_data_out 
                   (list 
                     (list Z_JD U_JD ang_JD) 
                     (list Z_ZH U_ZH ang_ZH) 
                     (list Z_HY U_HY ang_HY) 
                     (list Z_QZ U_QZ ang_QZ) 
                     (list Z_YH U_YH ang_YH) 
                     (list Z_HZ U_HZ ang_HZ) 
                   ) 
            ) 
            ;; 创建transformation_group_data_out 函数用参数   data_origin  data_insert   
            (setq 
              data_origin (list 0 U_JD 0) 
              data_insert (list 0 U_ZD_real quadrant_ang) 
            ) 
            ;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度quadrant_ang 
            (setq group_data_out 
                   (transformation_group_data_out 
                     group_data_out 
                     reflex 
                     data_origin 
                     data_insert 
                   ) 
            ) 
            ;;利用group_data_out数组 设置线元参数: (( 转点号I j)  R_start R_end  transition_parameter  reflex quadrant_ang  Z_start  U_insert ) 
            (cond 
              ((and (/= Lh1 0) 
                    (/= Lh2 0) 
               ) 
               (setq lst  (list 1 2 4) 
                     lst3 (list 0 1 2) 
               ) 
              ) 
              ((and (= Lh1 0) 
                    (/= Lh2 0) 
 
               ) 
               (setq lst  (list 2 4) 
                     lst3 (list 1 2) 
               ) 
              ) 
              ((and (/= Lh1 0) 
                    (= Lh2 0) 
               ) 
               (setq lst  (list 1 2) 
                     lst3 (list 0 1) 
               ) 
              ) 
              ((and (= Lh1 0) 
                    (= Lh2 0) 
               ) 
               (setq lst  (list 2) 
                     lst3 (list 1) 
               ) 
              ) 
            )                                ; cond  函数结束   
            (setq 
              group 
                            (mapcar '(lambda (i / lst2) 
                                       (setq lst2 (nth i group_data_out)) 
                                       (list (caddr lst2) (car lst2) (cadr lst2)) 
                                     ) 
                                    (list 1 2 4) 
                            ) 
              lst_4            (list (list (list Z_I 0) 0 R (list Lh1 A1) reflex) 
                                  (list (list Z_I 1) R R Ly reflex) 
                                  (list (list Z_I 2) R 0 (list Lh2 A2) reflex) 
                            ) 
              Line_segments (mapcar '(lambda (i) 
                                       (append (nth i lst_4) (nth i group)) 
                                     ) 
                                    lst3 
                            ) 
            ) 
            (list Line_segments (list T1 T2 adjusted_value)) 
          ) 
         subset 
  ) 
 
)                                        ;   evaluation_easement_curve 函数结束 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888    
 
 
 
 
 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888   
;; (setq group_turning_point ( create_turning_point_group )  )    
;; 求包含非完整缓和曲线的线元要素 入口变量: [ ( 转点号I T)   U_转点  ( R_start R R_end   Lh1  Lh2  )(α1  α2   Δ Dist_1   Dist_2 )] 
;; 出口变量:该转点各线元的数据[( 转点号I j)   R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert )  ]    
(defun evaluation_no_symmetrical_curve (subset / Z_I U group_data_out) 
  ;; (setq subset (nth 11   group_turning_point )) 
  (setq        Z_I         (car (car subset))        ; 转点编号 
        subset_2 (cdr subset) 
  ) 
  ;; (setq U_ZD_real (car subset_2) lst1  (cadr subset_2) lst2  (caddr subset_2) )    
  (apply '(lambda (U_ZD_real lst1      lst2         / 
                   ;; 计算交点用参数 
                   quadrant_ang               Δ 
                   ;; 计算切线长度 T1 T2 所用参数 
                   T1             T2               group_Z         Lh1_start Lh2_start 
                   ;; 计算缓和曲线的内蕴参数 
                   parameter Lh1       Lh2         R           A1 
                   A2             p1               p2         q1           q2 
                   β1             β2       βy         E           Ly 
                   L             adjusted_value         reflex 
                   ;; 建立线元坐标系所用参数 
                   U_center  U_ZD      U_ZH         U_HY           U_QZ 
                   U_YH             U_HZ 
                   ;; 桩号用参数 
                   Z_JD             Z_ZH      Z_HY         Z_QZ           Z_YH 
                   Z_HZ 
                   ;; 切线角用参数   
                   ang_JD    ang_ZH    ang_HY         ang_QZ           ang_YH 
                   ang_HZ 
                   ;; 对数组 group_data_out 进行移位，镜像，旋转 用参数 
                   quadrant_ang               data_origin           data_insert 
                   ;;创建线元列表所用参数   
                   lst             lst2      lst3         lst4           Line_segments 
                  ) 
            (setq R_start (car lst1) 
                  R (cadr lst1) 
                  R_end        (caddr lst1) 
                  Lh1 (nth 3 lst1) 
                  Lh2 (nth 4 lst1) 
                  quadrant_ang 
                   (car lst2)                ; 设计交点的入口方位角   
                  Δ (caddr lst2)        ; 设计交点偏转系数 
            ) 
            (if        (= R_start 0) 
              (setq R_start (expt 10.0 30)) 
            ) 
            (if        (= R_end 0) 
              (setq R_end (expt 10.0 30)) 
            ) 
            (if        (>= Δ 0) 
              (setq reflex 1) 
              (setq reflex -1 
                    Δ           (* -1 Δ) 
              )                                ; (setq Δ (/ pi 3))    
            ) 
            ;; 当出口 缓和曲线长度不相等时 
            (if        (/= Lh1 0) 
              (progn 
                ;; 创建lst结构 ( ( 转点号I j)  R_start R_end  transition_parameter    reflex         quadrant_ang    Z_start  U_insert )   
                (setq 
                  A1 
                     (abs (- (/ 1.0 R) 
                             (/ 1.0 R_start) 
                          ) 
                     ) 
                  A1 
                     (sqrt (/ Lh1 A1)) 
                ) 
                ;; 求入口非完整缓和曲线的HY点 ( z_桩号 U_z ang  )   
                (setq lst     (list R_start 
                                    R 
                                    (list Lh1 A1) 
                                    1 
                                    0        ; 线元的起点方位角 
                                    0 
                                    (list 0 0) 
                              ) 
                      group_Z (list Lh1) 
                ) 
                (setq group (solve_transition_curve group_Z lst) 
                      U_HY  (cadr (car group)) 
                      β1   (caddr (car group)) 
                ) 
                ;; (setq group_data_out (solve_transition_curve  ( create_group_Z  0  Lh1   1)  lst ))  (tang_test   group_data_out ) 
              ) 
              (setq β1 0)                ; 当Lh1长度为0 时 ， β1 偏角为0   
            ) 
            ;; 求出口口非完整缓和曲线的HY点 ( z_桩号 U_z ang  ) (以YH点为0点，右手螺旋坐标系，过YH点的切线为0度 ) 
            (if        (/= Lh2 0) 
              (progn 
                ;; 创建lst结构 ( R_start R_end  transition_parameter    reflex         quadrant_ang    Z_start  U_insert )   
                (setq 
                  A2 
                     (abs (- (/ 1.0 R) 
                             (/ 1.0 R_end) 
                          ) 
                     ) 
                  A2 
                     (sqrt (/ Lh2 A2)) 
                ) 
                (setq lst     (list R 
                                    R_end 
                                    (list Lh2 A2) 
                                    1 
                                    0        ; 线元的起点方位角 
                                    0 
                                    (list 0 0) 
                              ) 
                      group_Z (list Lh2) 
                ) 
                (setq group (solve_transition_curve group_Z lst) 
                      β2   (caddr (car group)) 
                ) 
              ) 
              (setq β2 0)                ; 当Lh2长度为0 时 ， β2 偏角为0   
            )                                ; (if        (/= Lh2 0) 函数结束 
 
            ;; 计算圆曲线的偏角 
            (setq βy (- Δ (+ β2 β1)) 
                  Ly  (* R βy)                ; 圆曲线长度   
            ) 
 
            ;; 创建lst结构 ( R_start R_end  lenth    reflex         quadrant_ang    Z_start  U_insert )   
            (setq lst          (list R R Ly 1 β1 0 U_HY) 
                  group_Z (list Ly)        ; YH 点的桩号 
            ) 
            (setq group        (solve_circular_arc group_Z lst) 
                                        ; 求圆曲线的终点坐标 
                  U_YH        (cadr (car group)) 
            ) 
            ;; (setq group_data_out (solve_circular_arc  ( create_group_Z  0  Ly  1)  lst ))  (tang_test   group_data_out )   
            (if        (/= Lh2 0) 
              (progn 
                ;;求HZ点的 group_data_out 的数组( z_桩号 U_z ang  )   
                (setq lst     (list R 
                                    R_end 
                                    (list Lh2 A2) 
                                    1 
                                    (+ βy β1) ; 线元的起点方位角 
                                    0        ; 线元的起始桩号    
                                    U_YH 
                              ) 
                      group_Z (list Lh2) ; HZ点桩号 
                ) 
                (setq group (solve_transition_curve group_Z lst) 
                      U_HZ  (cadr (car group)) 
                                        ; 求第二缓和曲线在 以HZ点为坐标原点，起点缓和曲线切线为X轴方向 
                ) 
                ;; (setq group_data_out (solve_transition_curve  ( create_group_Z  0  Lh2   1)  lst ))  (tang_test   group_data_out )   
              ) 
              (setq U_HZ U_YH) 
            )                                ; (if        (/= Lh2 0) 函数结束 
 
            ;; 求次坐标系中的转点坐标 U_ZD 
            (setq U_HZ_2 (polar U_HZ Δ 100.0) 
                  U_ZD         (inters U_HZ 
                                 U_HZ_2 
                                 (list 0 0) 
                                 (list 10000 0) 
                                 nil 
                         ) 
            ) 
            ;;  (setq tang99 (list  (list 0 0) U_HY  U_YH   U_HZ  U_ZD  ))( create_LWPOLYLINE  tang99 nil  "0"  )       
 
            (setq T1                 (car U_ZD) 
                  T2                 (distance U_ZD U_HZ) 
                  L                 (+ Ly (+ Lh1 Lh2)) 
                  adjusted_value (- (+ T1 T2) L) ; 切曲差   
            ) 
 
            ;; 以ZH点为坐标原点，该点的切线方向为X轴，建立右手螺旋坐标系 ,转角 Δ取正数    
            ;;转点的桩号 Z_JD = z_QZ + adjusted_value 
            (setq ang_JD (/ Δ 2) 
                  ;; 设置为U_JD ->U_center的垂直方向 
                  ang_ZH 0 
                  ang_HY β1 
                  ang_QZ (+ β1 (/ βy 2)) 
                  ang_YH (- Δ β2) 
                  ang_HZ Δ 
            ) 
            ;;   (angtos   (+(/ (- pi Δ) 2)Δ)   1 6  )    
            (setq 
              U_center (polar U_HY (+ ang_HY (* pi 0.5)) R) 
              U_ZH     (list 0 0)        ;向量U_center ->U_JD 的方位角 (+ (/ Δ 2)pi)    
              U_QZ     (polar U_center (- ang_QZ (* pi 0.5)) R) 
            ) 
            (setq Z_JD T1 
                  Z_ZH 0 
                  Z_HY Lh1 
                  Z_QZ (+ Lh1 (/ Ly 2)) 
                  Z_YH (+ Lh1 Ly) 
                  Z_HZ L 
            ) 
            (setq group_data_out 
                   (list 
                     (list Z_JD U_ZD ang_JD) 
                     (list Z_ZH U_ZH ang_ZH) 
                     (list Z_HY U_HY ang_HY) 
                     (list Z_QZ U_QZ ang_QZ) 
                     (list Z_YH U_YH ang_YH) 
                     (list Z_HZ U_HZ ang_HZ) 
                   ) 
            ) 
            ;; 创建transformation_group_data_out 函数用参数   data_origin  data_insert   
            (setq 
              data_origin (list 0 U_ZD 0) 
              data_insert (list 0 U_ZD_real quadrant_ang) 
            ) 
            ;; 对点集合 group_point 首先进行镜像变换，然后把变换后的点集合从U_origin 以为到U_insert ,然后围绕U_insert点旋转制定的角度quadrant_ang 
            (setq group_data_out 
                   (transformation_group_data_out 
                     group_data_out 
                     reflex 
                     data_origin 
                     data_insert 
                   ) 
            ) 
            ;;利用group_data_out数组 设置线元参数: ( R_start R_end  transition_parameter  reflex quadrant_ang  Z_start  U_insert ) 
            (cond 
              ((and (/= Lh1 0) 
                    (/= Lh2 0) 
               ) 
               (setq lst  (list 1 2 4) 
                     lst3 (list 0 1 2) 
               ) 
              ) 
              ((and (= Lh1 0) 
                    (/= Lh2 0) 
 
               ) 
               (setq lst  (list 2 4) 
                     lst3 (list 1 2) 
               ) 
              ) 
              ((and (/= Lh1 0) 
                    (= Lh2 0) 
               ) 
               (setq lst  (list 1 2) 
                     lst3 (list 0 1) 
               ) 
              ) 
              ((and (= Lh1 0) 
                    (= Lh2 0) 
               ) 
               (setq lst  (list 2) 
                     lst3 (list 1) 
 
               ) 
              ) 
            )                                ; cond  函数结束   
            (setq 
              group 
                            (mapcar '(lambda (i / lst2) 
                                       (setq lst2 (nth i group_data_out)) 
                                       (list (caddr lst2) (car lst2) (cadr lst2)) 
                                     ) 
                                    (list 1 2 4) 
                            ) 
              lst_4            (list (list (list Z_I 0) R_start R (list Lh1 A1) reflex) 
                                  (list (list Z_I 1) R R Ly reflex) 
                                  (list (list Z_I 2) R R_end (list Lh2 A2) reflex) 
                            ) 
              Line_segments (mapcar '(lambda (i) 
                                       (append (nth i lst_4) (nth i group)) 
                                     ) 
                                    lst3 
                            ) 
            ) 
            (list Line_segments (list T1 T2 adjusted_value)) 
          ) 
         subset_2 
  ) 
 
 
)                                        ;   evaluation_easement_curve 函数结束 
;;888888888888888888888888888888888888888888888888888888888888888888888888888888888    
 
 
 
 
;;  (setq group_turning_point ( create_turning_point_group )  ) 
;; 求线路的线元参数group_Line_segments [( 转点号I j) R_start R_end  transition_parameter   reflex  quadrant_ang   Z_start  U_insert ]   
;; 以及转点参数  group_data_JD  ( Z_JD U ang JD  reflex )   
(defun create_group_Line_segments 
                                  (group_turning_point 
                                   Z_road_start           / 
                                   group_turning_point_2 
                                   lst                   state 
                                   i                   dist 
                                   quadrant_ang           num 
                                   T_front           Δ 
                                   U_insert           U 
                                   Z                   group_parameter 
                                   group_Line_segments 
                                   group_data_JD 
                                  ) 
  ;; 去掉group_turning_point 中的第一和最后一个转点，不进行处理 
  (setq        group_turning_point_2 
         (cdr group_turning_point) 
        group_turning_point_2 
         (reverse group_turning_point_2) 
        group_turning_point_2 
         (cdr group_turning_point_2) 
        group_turning_point_2 
         (reverse group_turning_point_2) 
  ) 
  ;; 创建线元集合group_Line_segments [( 转点号I j) R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert ]    
  ;; 和 转点用的参数集合 group_parameter (list T1 T2 adjusted_value) 
  (setq 
    group_Line_segments 
     nil 
    group_parameter 
     nil 
  ) 
  (mapcar '(lambda                        ; (setq subset (nth 9 group_turning_point ) )    
             (subset / Line_segments state lst lst2) 
              (setq state (cadr (car subset))) 
                                        ; 判断该转点是否包含非完整缓和曲线    
              (if state 
                (setq lst 
                       (evaluation_no_symmetrical_curve subset) 
                      Line_segments 
                       (car lst) 
                      lst2 (cadr lst) 
 
                ) 
                (setq lst 
                       (evaluation_symmetrical_curve subset) 
                      Line_segments 
                       (car lst) 
                      lst2 (cadr lst) 
 
                ) 
              ) 
              (setq group_Line_segments 
                     (cons Line_segments group_Line_segments) 
                    group_parameter 
                     (cons lst2 group_parameter) 
              ) 
           ) 
          group_turning_point_2 
  ) 
  (setq        group_Line_segments 
         (reverse group_Line_segments) 
        group_parameter 
         (reverse group_parameter) 
  ) 
  ;;利用参数group_parameter (list T1 T2 adjusted_value)   和group_turning_point  把直线线元加进group_Line_segments 中 
  (setq        i 0 
        n (length group_Line_segments) 
  ) 
  ;; 把第二个转点至最后一个转点的直线线元加进数组group_Line_segments 中 
  (setq        group_Line_segments 
         (mapcar 
           '(lambda 
              (lst         /           dist             lst2      T_back 
               T_now         T_front   Δ             U_JD      quadrant_ang 
               U_insert         element   num             Z_start 
              ) 
               (cond 
                 ((/= i (- n 1))        ; 当转点num 不是最后一个转点时   
                  (setq        T_now               (cadr (nth i group_parameter)) 
                        T_back               (car (nth i group_parameter)) 
                        adjusted_value (caddr (nth i group_parameter)) 
                        T_front               (car (nth (+ i 1) group_parameter)) 
                        lst2               (nth (+ i 1) group_turning_point) 
                                        ; 线元所对应的转点号   
                        dist               (nth 4 (nth 3 lst2)) 
                        quadrant_ang   (cadr (nth 3 lst2)) 
                        Δ               (- dist (+ T_now T_front)) 
                                        ;直线线元的长度 
                        num               (car (car lst2)) ; 转点号 
                        Z_start               (- (+ T_now T_back) adjusted_value) 
                                        ;线元的起点桩号   
                  ) 
                 ) 
                 ;;   当转点num  是最后一个转点时    
                 ((= i (- n 1)) 
                  (setq        T_now               (cadr (nth i group_parameter)) 
                        T_back               (car (nth i group_parameter)) 
                        adjusted_value (caddr (nth i group_parameter)) 
                        T_front               0;  最后一个转点的切线长度设置为0    
                        lst2               (nth (+ i 1) group_turning_point) 
                                        ; 线元所对应的转点号   
                        dist               (nth 4 (nth 3 lst2)) 
                        quadrant_ang   (cadr (nth 3 lst2)) 
                        Δ               (- dist (+ T_now T_front)) 
                        num               (car (car lst2)) ; 转点号 
                        Z_start               (- (+ T_now T_back) adjusted_value) 
                                        ;线元的起点桩号   
                  ) 
                 ) 
               ) 
               (setq i (+ i 1)) 
               ;; 当 Δ 长度大于0.1米 时， 在该转点处加进直线线元 
               (if (> Δ 0.1) 
                 (progn 
                   (setq U_JD          (cadr lst2) 
                         U_insert (polar U_JD quadrant_ang T_now) 
                         num          (car (car lst2)) 
                   ) 
                   ;; 创建直线线元[( 转点号I 3)  0  0   Δ    reflex  quadrant_ang    Z_start  U_insert ]   
                   (setq element (list (list num 3) 
                                       0 
                                       0 
                                       Δ 
                                       1 
                                       quadrant_ang 
                                       Z_start 
                                       U_insert 
                                 ) 
                         lst         (append lst (list element)) 
                   ) 
                 ) 
               )                        ; (if (> Δ 0.1) 函数结束 
               lst 
            ) 
           group_Line_segments 
         ) 
  ) 
  ;; 把第一直线线元加进数组 group_Line_segments   
  (setq        lst             (car group_turning_point) 
        dist             (nth 4 (nth 3 lst)) 
        quadrant_ang (cadr (nth 3 lst)) 
        U_insert     (cadr lst)                ; 第一个转点的 坐标 
        num             (car (car lst))        ; 第一个线元的转点号    
        lst             (car group_parameter) 
        T_front             (car lst)                ; 第二个转点 的入口方向切线长度 
        Δ             (- dist T_front) 
  ) 
  ;; 判断第一个线元的转点是否存在 
  (if (> Δ 0.1) 
    (progn 
      (setq element (list (list num 3) 
                          0 
                          0 
                          Δ 
                          1 
                          quadrant_ang 
                          0 
                          U_insert 
                    ) 
 
      ) 
      (setq group_Line_segments 
             (append (list (list element)) group_Line_segments) 
      ) 
    ) 
  ) 
  ;; 对线元数组 group_Line_segments 中的起始桩号进行处理，   
  (if (not Z_road_start) 
    (setq Z_road_start 0)                ; 当线路起始桩号没有定义时，设置为0   
  ) 
  (setq Z Z_road_start)                        ; 初始化桩号Z 为路线的起始桩号 
  (setq        group_Line_segments 
         (mapcar 
           '(lambda (lst / element lenth) 
              (setq lst 
                     (mapcar 
                       '(lambda        (subset) 
                          (apply '(lambda (x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7) 
                                    (list x_0 x_1 x_2 x_3 x_4 x_5 (+ Z x_6) x_7) 
                                  ) 
                                 subset 
                          ) 
                        ) 
                       lst 
                     ) 
              )                                ;  (mapcar '(lambda        (subset) 函数结束 
              ;; 当一个转点 的全部线元处理完毕后， 对该转点的最后一个线元的结束桩号，赋值给Z 
              (setq element (last lst))        ; 该转点的最后一个线元 
              (if (= (cadr (car element)) 2) 
                (setq lenth (car (nth 3 element))) 
                                        ; 当最后一个线元是缓和曲线时   
                (setq lenth (nth 3 element)) 
              ) 
              (setq Z (+ (nth 6 element) lenth)) 
              lst                        ; 保证输出结果为想要的group_Line_segments 数组   
            ) 
           group_Line_segments 
         ) 
  ) 
  ;; 对group_turning_point 中的交点 ，求其交点桩号，病并求其象限角，以转角的一半为切线方向    
 
  (setq group_data_JD nil)                ; 利用数组group_Line_segments和group_parameter (list T1 T2 adjusted_value) 求解 
  (setq i 1) 
  (setq        group_data_JD 
         (mapcar '(lambda (lst / T1 Z Z_JD lst2 U ang JD Δ reflex) 
                    (setq T1         (car lst) 
                          lst2         (nth i group_Line_segments) 
                          Z         (nth 6 (car lst2)) 
                                        ; 该交点中的第一个线元的起点桩号 
                          Z_JD         (+ Z T1) 
                          reflex (nth 4 (car lst2)) 
                    ) 
                    (setq lst2 (nth i group_turning_point) 
                          U    (cadr lst2) 
                          JD   (car (car lst2)) 
                          Δ   (caddr (nth 3 lst2)) 
                          ang  (car (nth 3 lst2)) 
                          ang  (+ (* 0.5 Δ) ang) 
                    ) 
                    (setq i (+ i 1)) 
                    (list Z_JD U ang JD reflex) 
                  ) 
                 group_parameter 
         ) 
  ) 
 
 
  (list group_Line_segments group_data_JD) 
) 
;; 88888888888           88888888888888            88888888888888888          88888888888888888888    
 
 
 
 
 
;; 计算线路加宽值8888888888            8888888888888888888              88888888888888888888           88888888888888888888    
;;从文件中写入加宽数组 ，  输出 数组group_widen 其格式为 ( 转点号   widen 线路加宽值)   
(defun write_into_group_widen (/ lst fname f1 group group_widen) 
 
  (setq fname (getfiled "\n输入存放线路交点加宽参数的文件" "" "txt" 1)) 
  (if (/= fname nil) 
    (progn 
      (setq f1 (open fname 
                     "r" 
               ) 
      ) 
      (while (setq list_1 (read-line f1)) 
        (setq group (cons list_1 group)) 
      ) 
      (setq group (reverse group)) 
      (setq 
        group_widen 
         nil 
      ) 
      (setq group_widen 
             (mapcar '(lambda (x) 
                        (read x) 
                      ) 
                     group 
             ) 
      ) 
      (close f1)                        ;关闭文件fname 
    )                                        ;  progn 函数结束 
  )                                        ;if (/= fname nil) 函数结束 
  group_widen 
)                                        ; write_into_group_widen 函数结束 
;; 88888888888888888888888888888888888       (write_into_group_widen )       
;;  (setq  group_widen (write_into_group_widen))   
 
 
 
 
;; 输入参数 线元 Line_segments [( 转点号I j) R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert ]    
;; mold加宽类型 ，mold为0时, 绘制普通加宽，mold=1 时，按直线加宽 
(defun calculate_Transition-curve_widen 
                                        (Z          group_widen 
                                         Line_segments           mold 
                                         /          L           widen 
                                         k          k_2           k_3 
                                         l_x          T_1           T_2 
                                         T_3          widen_x  lenth 
                                         lst          Z_end 
                                        ) 
  (apply 
    '(lambda (x_0 x_1 x_2 transition_parameter reflex x_5 Z_start x_7) 
       (setq I         (car x_0)                ; 转点的编号 
             num (cadr x_0)                ; 线元在转点中的编号 
       ) 
       (setq lst   (assoc I group_widen) 
                                        ; 寻找转点I 所对应的加宽值    
             widen (cadr lst) 
       ) 
       (if (not widen) 
         (setq widen 0) 
       ) 
       (if (or (= num 0) 
               (= num 2) 
           ) 
         ;; 当线元为缓和曲线时   
         (progn 
           (setq lenth (car transition_parameter) 
                 lenth (* lenth 1.0) 
                 Z_end (+ Z_start lenth) 
           ) 
           (if (and 
                 (>= Z z_start) 
                 (<= Z z_end) 
               ) 
             (progn 
               (cond 
                 ;; 当线元为进口缓和曲线时   
                 ((= num 0) 
                  (setq L (- Z z_start)) 
                 ) 
                 ;; 当线元为出口缓和曲线时   
                 ((= num 2) 
                  (setq L (- z_end z)) 
                 ) 
               )                        ; cond 函数结束    
               (setq k (/ L lenth)) 
               ;; 当 mold为0时, 绘制普通加宽，mold=1 时，按直线加宽 
               (cond 
                 ((= mold 0) 
                  (setq        k_2        (* (expt k 3) 4) 
                        k_3        (* (expt k 4) 3) 
                        widen_x        (* (- k_2 k_3) widen) 
                  ) 
                 ) 
                 ((= mold 1) 
                  (setq widen_x (* k widen)) 
                 ) 
               )                        ; 判断 缓和曲线是否为普通或直线加宽的函数 结束    
             ) 
           )                                ; (if (and  (>= Z z_start) (< Z z_end) ) 函数结束 
         ) 
       )                                ; 处理缓和曲线线元加宽值的 函数结束 
       (if (= num 1) 
         ;; 当线元为圆曲线时    
         (progn 
           (setq lenth (* transition_parameter 1.0) 
                 Z_end (+ Z_start lenth) 
           ) 
           (if (and 
                 (>= Z z_start) 
                 (<= Z z_end) 
               ) 
             (setq widen_x widen) 
           )                                ; (if (and  (>= Z z_start) (< Z z_end) ) 函数结束 
         ) 
       )                                ; 处理圆曲线线元加宽值的 函数结束 
       (if (not widen_x) 
         (setq widen_x 0) 
         widen_x 
       ) 
     ) 
    Line_segments 
  ) 
)                                        ; calculate_Transition-curve_widen函数结束 
;; (calculate_Transition-curve_widen 7530  group_widen Line_segments  0 )    
;;  (setq  group_widen (write_into_group_widen))   
;; (setq Line_segments  (cadr(nth 2 tang99 )))  (setq   mold 0  z 7570  I 25  )      
 
 
 
 
 
;; 绘图用函数88888    绘图用函数88888     绘图用函数88888     绘图用函数88888    绘图用函数88888    绘图用函数88888    绘图用函数88888   
 
 
;; 对group_data_out 数组进行标注,   Wide 为标注点离中心线的距离 , color 为文字颜色    
(defun draw_group_data_out 
                           (group_data_out          color             Wide 
                            /               group          Z_start    group 
                            n_point 
                           ) 
  (setq group (mapcar 'cadr group_data_out)) 
  (entmake (append (list '(0 . "LWPOLYLINE") 
                         '(100 . "AcDbEntity") 
                         (cons 62 color) 
                         '(100 . "AcDbPolyline") 
                         (cons 90 (length group)) 
                   ) 
                   (mapcar '(lambda (U) (cons 10 U)) group) 
           ) 
  ) 
 
  (setq        n_point        (length group_data_out) 
        Z_start        (car (car group_data_out)) 
  ) 
  (if (not Wide) 
    (setq Wide 8) 
  ) 
  (mapcar 
    '(lambda (lst / Z U ang string U_offset U_move) 
       (setq Z         (car lst) 
             U         (cadr lst) 
             ang (+ (caddr lst) 
                    (* 0.5 pi) 
                 ) 
       ) 
       (setq string   (f_zhuanghao Z) 
             U_offset (polar U ang Wide) 
             U_move   (polar U ang (* Wide 2.2)) 
       ) 
       (if (or (= (rem Z 10) 0) 
               (= state_label "completely") 
           ) 
         (progn 
           (entmakex 
             (list '(0 . "line") 
                   (cons 62 color) 
                   (cons 10 U) 
                   (cons 11 U_offset) 
             ) 
           ) 
           ;; 对文字的 方向角度进行控制，使得其保持在0--180度之内 
           (if (> ang pi) 
             (setq ang (- ang pi)) 
           ) 
           (entmake 
             (list '(0 . "TEXT") 
                   (cons 62 color) 
                   (append '(10) U_move) 
                   (cons 40 3) 
                   (cons '1 string) 
                   (cons 50 ang) 
                   '(72 . 1) 
                   (append '(11) U_move) 
                   '(73 . 2) 
             ) 
           ) 
         ) 
       ) 
     ) 
    group_data_out 
  ) 
 
) 
;; 888888888888            88888888888888888           88888888888888888888                   
 
 
 
 
 
;; 对线元参数group_Line_segments [( 转点号num j) R_start R_end  transition_parameter   reflex  quadrant_ang   Z_start  U_insert ]   
;; 求出一个新的数组 group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的 前后线元编号  i k 取值为0 ，1 ，2 ,3   
(defun create_group_transition 
                               (group_Line_segments 
                                /              group_transition 
                                group              n_1 
                                n              group_i 
                                lst              num 
                               ) 
  (setq group (apply 'append group_Line_segments)) 
  ;; 为了计算方便，在数组group的头和尾巴各加入一个数组   
  (setq        lst   (car (car group)) 
        num   (car lst) 
        lst   (list (list num 3)) 
        group (append (list lst) group) 
        lst   (car (last group)) 
        num   (car lst) 
        lst   (list (list num 3)) 
        group (append group (list lst)) 
  ) 
  (setq        n        (length group) 
        n_1        1 
        group_i        nil 
  ) 
  (repeat (- n 2) 
    (setq group_i (cons n_1 group_i)) 
    (setq n_1 (+ n_1 1)) 
  ) 
  (setq group_i (reverse group_i)) 
  (setq group_transition nil) 
  (mapcar '(lambda (n_1 / lst lst_back lst_front i j k) 
             (setq lst (nth n_1 group) 
                   j   (cadr (car lst)) 
             ) 
             (setq lst_back  (nth (- n_1 1) group) 
                   lst_front 
                             (nth (+ n_1 1) group) 
             ) 
             (setq i (cadr (car lst_back)) 
                   k (cadr (car lst_front)) 
             ) 
             (setq group_transition 
                    (cons (list (car lst) (list i j k)) 
                          group_transition 
                    ) 
             ) 
           ) 
          group_i 
  ) 
  (reverse group_transition) 
)                                        ; (defun create_group_transition   函数结束   
;; (setq group_transition ( create_group_transition group_Line_segments ) )    
 
 
 
;; 绘制公路曲线中心线 
;; (setq Line_segments   (cadr group_Line_segments ) )   
;; group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的 前后线元编号  i k 取值为0 ，1 ，2 ,3   
(defun draw_center_line 
       (Line_segments group_transition / lst group_transition) 
  (mapcar 
    '(lambda 
       (subset / lst group_Z num Z_start Z_end len group_data_out array 
        j) 
        ;;去除 [( 转点号I j)   R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert )]中的第一个元素   
        (setq array   (car subset) 
              num     (cadr array) 
              subset  (cdr subset) 
              Z_start 
                      (nth 5 subset) 
        ) 
        (cond 
          ((or (= num 0) 
               (= num 2) 
           ) 
           (progn 
             (setq len           (car (caddr subset)) 
                   Z_end   (+ Z_start len) 
                   group_Z (create_group_Z Z_start Z_end 1) 
             ) 
             (setq group_data_out 
                    (solve_transition_curve group_Z subset) 
             ) 
           ) 
          ) 
          ((= num 1) 
           (progn 
             (setq len           (caddr subset) 
                   Z_end   (+ Z_start len) 
                   group_Z (create_group_Z Z_start Z_end 1) 
             ) 
             (setq group_data_out (solve_circular_arc group_Z subset)) 
           ) 
          ) 
          ((= num 3) 
           (progn 
             (setq len           (caddr subset) 
                   Z_end   (+ Z_start len) 
                   group_Z (create_group_Z Z_start Z_end 1) 
             ) 
             (setq group_data_out (solve_straightway group_Z subset)) 
           ) 
          ) 
        ) 
        (setq lst   (cadr (assoc array group_transition)) 
              group (mapcar 'cadr group_data_out) 
        ) 
        (cond 
          ((= (cadr lst) 3)                ; 直线线元时 
           (setq j 1) 
          ) 
          ((= (cadr lst) 1)                ;圆曲线线元时 
           (setq j 2)                        ; 黄色   
          ) 
          ;; 当缓和曲线时接直线和圆时    
          ((or (equal lst '(3 0 1)) 
               (equal lst '(1 2 3)) 
           ) 
           (setq j 3)                        ; 绿色   
          ) 
          ;; 当缓和曲线时接缓和曲线和圆时    
          ((or (equal lst '(2 0 1)) 
               (equal lst '(1 2 0)) 
           ) 
           (setq j 6)                        ; 洋红色   
          ) 
          ;; 当缓和曲线是接圆和圆时    
          ((or (equal lst '(1 0 1)) 
               (equal lst '(1 2 1)) 
           ) 
           (setq j 4)                        ; 青色   
          ) 
          (t 
           (setq j 0) 
          ) 
        ) 
        (entmake (append (list '(0 . "LWPOLYLINE") 
                               '(100 . "AcDbEntity") 
                               (cons 62 j) 
                               '(100 . "AcDbPolyline") 
                               (cons 90 (length group)) 
                         ) 
                         (mapcar '(lambda (U) (cons 10 U)) group) 
                 ) 
        ) 
     ) 
    Line_segments 
  ) 
) 
;;     (setq e (entlast)) (command "zoom" "e")       
;;  (mapcar '(lambda (lst)  (draw_center_line   lst group_transition ) )   group_Line_segments )   
 
 
 
 
 
 
 
 
 
 
 
;; 绘制公路曲线左右边线 
;;  (setq group_turning_point ( create_turning_point_group )  )   
;;  (setq  group_widen (write_into_group_widen))      
(defun draw_side_boundary (Width         group_widen   Line_segments 
                           mold                 group_transition 
                           /                 lst 
                          ) 
  ;; (setq Width 5 )    
  (mapcar                                ;  (setq subset (car (nth 2 Line_segments )) )       
    '(lambda (subset        /          lst            group_Z   num 
              Z_start        Z_end          len            group_data_out 
              subset_2        i          array            color 
             ) 
       ;;去除 [( 转点号I j)   R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert )]中的第一个元素   
       (setq array    (car subset) 
             num      (cadr array) 
             subset_2 (cdr subset) 
             reflex   (nth 3 subset_2) 
             Z_start  (nth 5 subset_2) 
       ) 
       (cond 
         ((or (= num 0) 
              (= num 2) 
          ) 
          (progn 
            (setq len          (car (caddr subset_2)) 
                  Z_end          (+ Z_start len) 
                  group_Z (create_group_Z Z_start Z_end 1) 
            ) 
            (setq group_data_out 
                   (solve_transition_curve group_Z subset_2) 
            ) 
          ) 
         ) 
         ((= num 1) 
          (progn 
            (setq len          (caddr subset_2) 
                  Z_end          (+ Z_start len) 
                  group_Z (create_group_Z Z_start Z_end 1) 
            ) 
            (setq group_data_out (solve_circular_arc group_Z subset_2)) 
          ) 
         ) 
         ((= num 3) 
          (progn 
            (setq len          (caddr subset_2) 
                  Z_end          (+ Z_start len) 
                  group_Z (create_group_Z Z_start Z_end 1) 
            ) 
            (setq group_data_out (solve_straightway group_Z subset_2)) 
          ) 
         ) 
       )                                ; cond 函数结束 
       ;; 求group_Z 中每个桩号 的加宽值 , 当边线和转弯的方向一致时加宽 
       (if (minusp (* reflex Width)) 
         ;; 当边线 和路线转弯方向不一致时，加宽值设置为0    
         (setq group 
                (mapcar 
                  '(lambda (z) 
                     0 
                   ) 
                  group_Z 
                ) 
         ) 
         (setq group 
                (mapcar 
                  '(lambda (z) 
                     (calculate_Transition-curve_widen 
                       Z 
                       group_widen 
                       subset 
                       mold 
                     ) 
                   ) 
                  group_Z 
                ) 
         ) 
       ) 
       ;; 利用加宽数组 group 对group_data_out 沿中心线方向 进行偏移操作   
       (setq i 0 
             group_sideline 
              nil 
       ) 
       (mapcar '(lambda        (w / lst ang) 
                  (setq lst (nth i group_data_out)) 
                  (apply '(lambda (z U quadrant_ang) 
                            (if        (minusp Width) 
                              (setq quadrant_ang (+ quadrant_ang pi)) 
                            ) 
                            (setq ang (+ quadrant_ang (* 0.5 pi)) 
                                  U   (polar U ang (+ w (abs Width))) 
                            ) 
                            (setq group_sideline 
                                   (cons (list z U quadrant_ang) 
                                         group_sideline 
                                   ) 
                            ) 
                          ) 
                         lst 
                  ) 
                  (setq i (+ i 1)) 
                ) 
               group 
       ) 
       (setq group_sideline (reverse group_sideline)) 
       (setq lst   (cadr (assoc array group_transition)) 
             group (mapcar 'cadr group_data_out) 
       ) 
       (cond 
         ((= (cadr lst) 3)                ; 直线线元时 
          (setq color 1) 
         ) 
         ((= (cadr lst) 1)                ;圆曲线线元时 
          (setq color 2)                ; 黄色   
         ) 
         ;; 当缓和曲线时接直线和圆时    
         ((or (equal lst '(3 0 1)) 
              (equal lst '(1 2 3)) 
          ) 
          (setq color 3)                ; 绿色   
         ) 
         ;; 当缓和曲线时接缓和曲线和圆时    
         ((or (equal lst '(2 0 1)) 
              (equal lst '(1 2 0)) 
          ) 
          (setq color 6)                ; 洋红色   
         ) 
         ;; 当缓和曲线是接圆和圆时    
         ((or (equal lst '(1 0 1)) 
              (equal lst '(1 2 1)) 
          ) 
          (setq color 4)                ; 青色   
         ) 
         (t 
          (setq color 0) 
         ) 
       ) 
       (draw_group_data_out group_sideline color (abs Width)) 
     ) 
    Line_segments 
  ) 
) 
;; (setq  group_Line_segments (car ( create_group_Line_segments   group_turning_point  6782.755 ))  )    
;;  (mapcar '(lambda (lst)  (draw_side_boundary   3.5  group_widen  lst  0 group_transition  ) )   group_Line_segments )   
;;   (setq e (entlast)) (command "zoom" "e")         
 
 
 
 
 
;; group_Line_segments 结构    [( 转点号I j)   R_start R_end  transition_parameter   reflex  quadrant_ang    Z_start  U_insert )]   
;; 对线元集合group_Line_segments 中的起始点进行标注 
(defun label_Line_segments 
       (group_Line_segments group_transition / group group_2 i) 
 
  (setq group (apply 'append group_Line_segments)) 
  (mapcar '(lambda (lst              /                Z          quadrant_ang 
                    ang              U                string          string_2  array 
                    U_offset  U_move        reflex          color 
                   ) 
             (setq z                (nth 6 lst) 
                   U                (nth 7 lst) 
                   quadrant_ang        (nth 5 lst) 
                   reflex        (nth 4 lst) 
                   array        (car lst) 
             ) 
             ;;  group_transition ( 转点号num j) (i j k) ，i 和 k 分别为该线元的 前后线元编号  i k 取值为0 ，1 ，2 ,3    
             (setq array   (cadr (assoc array group_transition)) 
                   array_2 (list (car array) (cadr array)) 
             ) 
             (cond 
               ((equal array_2 
                       '(3 0) 
                ) 
                (setq string "ZH") 
               ) 
               ((equal array_2 
                       '(3 1) 
                ) 
                (setq string "ZY") 
               ) 
               ((equal array_2 
                       '(0 1) 
                ) 
                (setq string "HY") 
               ) 
               ((equal array_2 
                       '(1 0) 
                ) 
                (setq string "YH") 
               ) 
               ((equal array_2 
                       '(1 2) 
                ) 
                (setq string "YH") 
               ) 
               ((equal array_2 
                       '(1 3) 
                ) 
                (setq string "YZ") 
               ) 
               ((equal array_2 
                       '(2 3) 
                ) 
                (setq string "HZ") 
               ) 
               ((equal array_2 
                       '(2 0) 
                ) 
                (setq string "HH") 
               ) 
               ((equal array_2 
                       '(2 1) 
                ) 
                (setq string "HY") 
               ) 
               (t 
                (setq string "88") 
               ) 
             )                                ; cond 函数结束 
 
             (cond 
               ((= (cadr array) 3)        ; 直线线元时 
                (setq color 1) 
               ) 
               ((= (cadr array) 1)        ;圆曲线线元时 
                (setq color 2)                ; 黄色   
               ) 
               ;; 当缓和曲线时接直线和圆时    
               ((or (equal array '(3 0 1)) 
                    (equal array '(1 2 3)) 
                ) 
                (setq color 3)                ; 绿色   
               ) 
               ;; 当缓和曲线时接缓和曲线和圆时    
               ((or (equal array '(2 0 1)) 
                    (equal array '(1 2 0)) 
                ) 
                (setq color 6)                ; 洋红色   
               ) 
               ;; 当缓和曲线是接圆和圆时    
               ((or (equal array '(1 0 1)) 
                    (equal array '(1 2 1)) 
                ) 
                (setq color 4)                ; 青色   
               ) 
               (t 
                (setq color 0) 
               ) 
             ) 
             ;; 创建标注桩号用的文字符    
             (setq string_2 (f_zhuanghao Z) 
                   string   (strcat string ": " string_2) 
             ) 
             (setq 
               ang (+ quadrant_ang 
                      (* (* 0.5 pi) reflex) 
                   ) 
             ) 
             (setq U_offset (polar U ang 28) 
                   U_move   (polar U ang 48) 
             ) 
             (entmakex 
               (list '(0 . "line") 
                     (cons 62 color) 
                     (cons 10 U) 
                     (cons 11 U_offset) 
               ) 
             ) 
             ;; 对文字的 方向角度进行控制，使得其保持在0--180度之内 
             (if (> ang pi) 
               (setq ang (- ang pi)) 
             ) 
             (entmake 
               (list '(0 . "TEXT") 
                     (cons 62 color) 
                     (append '(10) U_move) 
                     (cons 40 3) 
                     (cons '1 string) 
                     (cons 50 ang) 
                     '(72 . 1) 
                     (append '(11) U_move) 
                     '(73 . 2) 
               ) 
             ) 
           ) 
          group 
  ) 
) 
;; (label_Line_segments   group_Line_segments group_transition )   
 
 
 
 
 
;; 对group_data_JD (list Z_JD U ang JD   reflex )   数组进行标注   
;;  (setq  lst  (create_group_Line_segments  group_turning_point  6782.755 )) (setq  group_data_JD (cadr lst))   
(defun lable_group_turning_point 
       (group_data_JD group_turning_point / group U) 
  ;; 画出group_turning_point 中的转点   
  (setq group (mapcar 'cadr group_turning_point)) 
  (entmake (append (list '(0 . "LWPOLYLINE") 
                         '(100 . "AcDbEntity") 
                         (cons 6 "tang") 
                         (cons 48 8) 
                         '(100 . "AcDbPolyline") 
                         (cons 90 (length group)) 
                   ) 
                   (mapcar '(lambda (U) (cons 10 U)) group) 
           ) 
  ) 
  ;; 对group_turning_point中的交点用数组group_data_JD 进行桩号标注   
  (mapcar 
    '(lambda (lst / string ang U_offset U_move lst2) 
       (apply '(lambda (Z U quadrant_ang JD reflex) 
                 (setq string (f_zhuanghao Z) 
                       string (strcat "JD" (itoa JD) ": " string) 
                 ) 
                 (setq 
                   ang          (- quadrant_ang 
                             (* (* 0.5 pi) reflex) 
                          ) 
                   U_move (polar U ang 50) 
                 ) 
                 ;; 对文字的 方向角度进行控制，使得其保持在0--180度之内   
                 (if (> ang pi) 
                   (setq ang (- ang pi)) 
                 ) 
                 (entmake 
                   (list '(0 . "TEXT") 
                         (append '(10) U_move) 
                         (cons 40 3) 
                         (cons '1 string) 
                         (cons 50 ang) 
                         '(72 . 1) 
                         (append '(11) U_move) 
                         '(73 . 2) 
                   ) 
                 ) 
               ) 
              lst 
       ) 
       ;; (setq lst ( car group_data_JD ))   
     ) 
    group_data_JD 
  ) 
)                                        ; test_tang_5 函数结束   
;; (lable_group_turning_point  group_data_JD group_turning_point )   
 
;; 绘图用函数函数结束 88888    绘图用函数函数结束88888     绘图用函数函数结束88888    绘图用函数函数结束88888    绘图用函数函数结束88888   绘图用函数函数结束    
 
 
 
 
 
 
;;  dcl使用文件       888888888888888888         dcl使用文件       888888888888888888     dcl使用文件       888888888888888888       
(setq dialog_tang 
       '("JD_item:list_box{  key="JD_list"; label="交点参数表："; value=0;" 
         "list=" ( 转点号  转点状态nil) 转点坐标  ( Lh1 R  Lh2  ) \\n ( 转点号  转点状态t) 转点坐标 (R_start R R_end  Lh1 Lh2 )";" 
         "allow_accept=true;}" 
         "Line_segments :list_box{  key="Line_segments"; label="线元参数参数表："; value=0;" 
         "list="( 转点号I j) 起点半径 终点半径  曲线长度  偏转系数  线元起点象限角  起点桩号  起点坐标 ) ";" 
         "allow_accept=true;}" 
         "table_wide :list_box{  key="table_wide"; label="交点加宽参数参数表："; value=0;" 
         "list=" 交点号  交点加宽值 ";" 
         "allow_accept=true;}" 
         "scfg:toggle{  label="曲线加宽方式,选中为直线加宽,不选普通加宽";  key="scfg";}" 
         "Z_road_start :edit_box {label="请选择线路起点桩号:";  key= "Z_road_start";value="0";allow_accept=true;}" 
         "Wide_L :edit_box {label="路线左幅宽度:";  key= "Wide_L";value="5";allow_accept=true;}" 
         "Wide_R :edit_box {label="路线右幅宽度:";  key= "Wide_R";value="10";allow_accept=true;}" 
         "insert_table_J :button {label="请选择交点参数列表:";  key= "insert_table_J";    }" 
         "insert_table_W :button {label="请选择加宽参数列表:";  key= "insert_table_W"; }" 
         "draw :button {label="绘制曲线:";  key= "draw"; fixed_width=true;width=12;}" 
         "calculate :button {label="计算线元参数:";  key= "calculate";  }" 
         "draw_road:" 
         "dialog{  label="用变换群的方法绘制公路曲线";  spacer;" 
         "fixed_width=true;" 
         "width=118;" 
         ": boxed_row  {JD_item;" 
         ": column {  fixed_width=true;width=20;" 
         "insert_table_J;  spacer;    calculate ; }" 
         "}" 
         "Line_segments ;" 
         ": boxed_row   { table_wide ;" 
         ": column{   fixed_width=true;width=50;" 
         "scfg ; insert_table_W ;" 
         "Z_road_start ; Wide_L ; Wide_R ;" 
         "}" 
         "}" 
         ": boxed_row   {    ok_cancel;  draw;     }" 
         "}" 
        ) 
 
) 
 
(defun Dcl_write (lst / dcl_file str file) 
  (vl-load-com) 
  (setq dcl_file (vl-filename-mktemp nil nil ".dcl")) 
  (setq file (open dcl_file "w")) 
  (foreach str lst (write-line str file)) 
  (close file) 
  (setq id (load_dialog dcl_file)) 
) 
 
(defun C:use_dcl (/                   id                    sdt 
                  group_turning_point                    group_Line_segments 
                  group_Line_segments                    group_widen 
                  W_L                   W_R                    mold 
                 ) 
  (if nil 
    (setq ID 
           (load_dialog 
             "D:\\工作文件\\新建文件夹\\work\\公路曲线简易程序\\绘制公路曲线" 
           ) 
    ) 
    (Dcl_write dialog_tang) 
  ) 
  ;; 创建一个绘制交点直线的线性    
  (if (not (tblobjname "LTYPE" "tang")) 
    (entmake 
      (list '(0 . "LTYPE") 
            '(100 . "AcDbSymbolTableRecord") 
            '(100 . "AcDbLinetypeTableRecord") 
            (cons 2 "tang")                ; 线形名    
            '(3 . "点画线 ____   ____   ____") ; 线型的说明文字    
 
            '(70 . 0)                        ;标准标记值（按位编码值） 
 
            '(73 . 2)                        ;线型元素的数目 
            '(40 . 20.0)                ; 图案总长度 
 
            '(49 . 15.0)                ; 虚线、点或空间长度（每个元素一个条目） 
            '(74 . 0)                        ; 复杂线型元素类型（每个元素一种类型）。 默认值为 0（无嵌入的形/文字） 
 
            ' 
             (49 . -5.0) 
            '(74 . 0) 
            '(46 . 50) 
      ) 
    ) 
  ) 
 
  (if (not (new_dialog "draw_road" id)) 
    (exit) 
  ) 
  (setq sdt 1) 
  (while (> sdt 0) 
 
    (action_tile 
      "insert_table_J" 
      "(action_insert_table_J) " 
    ) 
    (action_tile 
      "calculate" 
      "(action_calculate) " 
    ) 
    (action_tile 
      "insert_table_W" 
      "(action_insert_table_W) " 
    ) 
    (action_tile 
      "draw" 
      "(action_draw)(done_dialog -8 )" 
    ) 
    (setq sdt (start_dialog)) 
  ) 
  (unload_dialog id) 
  (if (= sdt -8) 
    (progn 
      (if group_Line_segments 
        (progn 
          (setq        group_transition 
                 (create_group_transition 
                   group_Line_segments 
                 ) 
          ) 
          (mapcar '(lambda (lst) (draw_center_line lst group_transition)) 
                  group_Line_segments 
          ) 
          (mapcar 
            '(lambda (lst) 
               (draw_side_boundary 
                 W_L group_widen lst mold group_transition) 
             ) 
            group_Line_segments 
          ) 
          (mapcar 
            '(lambda (lst) 
               (draw_side_boundary 
                 W_R group_widen lst mold group_transition) 
             ) 
            group_Line_segments 
          ) 
          (label_Line_segments group_Line_segments group_transition) 
        ) 
      ) 
      (if (and group_data_JD group_turning_point) 
        (lable_group_turning_point 
          group_data_JD 
          group_turning_point 
        ) 
      ) 
      (setq e (entlast)) 
      (command "zoom" "e") 
    ) 
  )                                        ;  (if (= sdt 8) 函数结束   
) 
;;       (setq e (car (entsel "pick a object :" )))    (setq tang  (entget e )  )    
 
 
(defun action_calculate        (/ lst group road_start group_sum n) 
  (setq        road_start (get_tile "Z_road_start") 
        road_start (atof road_start) 
  ) 
  (if group_turning_point 
    (progn 
      (setq 
        lst 
         (create_group_Line_segments group_turning_point road_start) 
        group_Line_segments 
         (car lst) 
        group_data_JD 
         (cadr lst) 
        group_sum (apply 'append group_Line_segments) 
      ) 
      ;; 用 group_Line_segments 填充列表框 "Line_segments" 
      (setq group_sum 
             (mapcar                        ; (setq lst (car group_sum))  (setq x_7 ( nth 7  lst))    
               '(lambda        (lst / lenth lst_label) 
                  (apply '(lambda (x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7) 
                            (setq x_0 (mapcar 'itoa x_0) 
                                  x_0 (list (car x_0) "-" (cadr x_0)) 
                                  x_0 (apply 'strcat x_0) 
                            ) 
                            (setq x_7 (mapcar 'rtos x_7) 
                                  x_7 (list "N:" (cadr x_7) " E:" (car x_7)) 
                                  x_7 (apply 'strcat x_7) 
                            ) 
                            (setq 
                              x_6 (f_zhuanghao x_6) 
                            ) 
                            (if        (atom x_3) 
                              (setq lenth x_3) 
                              (setq lenth (car x_3)) 
                            ) 
                            (setq lenth        (* lenth 1.0) 
                                  x_3        (rtos lenth 2 2) 
                                  x_5        (angtos x_5 1 6) 
                            ) 
                            ;; 对(list x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7 ) 进行标注 
                            (setq lst            (list x_0 x_1 x_2 x_3 x_4 x_5 x_6 x_7) 
                                  lst_label (list "R_s:" 
                                                  "R_e:" 
                                                  "lenth:" 
                                                  "reflex:" 
                                                  "α_s:" 
                                                 ) 
                                  lst            (append lst lst_label) 
                            ) 
                            ;;  lst顺序为 (0 1 2 3 4 5 6 7 8 9 10 11 12 ) 
                            (mapcar '(lambda (i) 
                                       (nth i lst) 
                                     ) 
                                    (list 0 8 1 9 2 10 3 11 4 12 5 6 7) 
                            ) 
 
                          ) 
                         lst 
                  ) 
                ) 
               group_sum 
             ) 
      ) 
      (setq group                        ; (setq lst (car group_sum ))   
             (mapcar '(lambda (lst / string) 
                        (setq string (vl-princ-to-string lst)) 
                        (setq string (vl-string-left-trim "\(" string) 
                              string (vl-string-right-trim "\)" string) 
                        ) 
                      ) 
                     group_sum 
             ) 
      ) 
      (start_list "Line_segments" 3) 
      (mapcar 'add_list group) 
      (end_list) 
      (setq n (length group)) 
      (set_tile "Line_segments" (itoa n)) 
    ) 
    ;; 当group_turning_point 数组为空时 
    (progn 
      (start_list "Line_segments" 2) 
      (mapcar 'add_list (list "您还没有输入交点数组!")) 
      (end_list) 
      (setq n (length group)) 
      (set_tile "Line_segments" (itoa n)) 
    ) 
  ) 
)                                        ;   action_calculate 函数结束 
 
 
(defun action_insert_table_W (/ lst group) 
  (setq group_widen (write_into_group_widen)) 
  ;; 用group_widen 数组分别对列表框 "table_wide" 进行填充 
  (setq        group 
         (mapcar '(lambda (lst 
                           / 
                           JD 
                           W 
                          ) 
                    (setq JD (itoa (car lst)) 
                          W  (rtos (cadr lst) 2 3) 
                    ) 
                    (strcat "JD: " JD "  加宽:" W) 
 
                  ) 
                 group_widen 
         ) 
  ) 
  (start_list "table_wide" 3) 
  (mapcar 'add_list group) 
  (end_list) 
)                                        ;   action_insert_table_W 函数结束 
 
;; 定义插入交点文件按钮的函数      
(defun action_insert_table_J (/ lst group) 
  (setq group_turning_point (create_turning_point_group)) 
  ;; 用group_turning_point 数组分别对列表框 "JD_list" 
  ;; 用group_turning_point 数组分别对列表框 "JD_list" 
  (setq        group 
         (mapcar 
           '(lambda (lst / state subset_label) 
              (apply '(lambda (x_0 x_1 x_2 x_3) 
                        (setq x_1 (mapcar 'rtos x_1) 
                              x_1 (list "N:" (cadr x_1) " E:" (car x_1)) 
                              x_1 (apply 'strcat x_1) 
                        ) 
                        (if (cadr x_0) 
                          (progn 
                            (setq state "Yes") 
                            (setq 
                              x_2 (apply '(lambda (y_0 y_1 y_2 y_3 y_4) 
                                            (setq subset_label (list "R_s" 
                                                                     "R" 
                                                                     "R_e" 
                                                                     "Lh1" 
                                                                     "Lh2") 
                                                  subset       (list y_0 y_1 y_2 y_3 y_4) 
                                                  subset       (append subset subset_label) 
                                            ) 
                                            (mapcar '(lambda (i) 
                                                       (nth i subset) 
                                                     ) 
                                                    (list 5 0 6 1 7 2 8 3 9 4) 
                                            ) 
                                          ) 
                                         x_2 
                                  ) 
                            ) 
                          ) 
                          (progn 
                            (setq state "No") 
                            (setq x_2 (apply '(lambda (y_0 y_1 y_2) 
                                                (setq subset_label (list "Lh1" "R" "Lh2") 
                                                      subset           (list y_0 y_1 y_2) 
                                                      subset           (append subset subset_label) 
                                                ) 
                                                (mapcar        '(lambda (i) 
                                                           (nth i subset) 
                                                         ) 
                                                        (list 3 0 4 1 5 2) 
                                                ) 
                                              ) 
                                             x_2 
                                      ) 
                            ) 
                          ) 
                        )                ; (if (cadr x_0) 函数结束 
                        (setq x_2 (vl-princ-to-string x_2) 
                              x_2 (vl-string-left-trim "\(" x_2) 
                              x_2 (vl-string-right-trim "\)" x_2) 
                        ) 
                        (list "JD:" (car x_0) state x_1 x_2) 
                      ) 
                     lst 
              ) 
            ) 
           group_turning_point 
         ) 
  ) 
  (setq        group 
         (mapcar '(lambda (lst / string) 
                    (setq string (vl-princ-to-string lst) 
                          string (vl-string-left-trim "\(" string) 
                          string (vl-string-right-trim "\)" string) 
                    ) 
                  ) 
                 group 
         ) 
  ) 
 
  (start_list "JD_list" 3) 
  (mapcar 'add_list group) 
  (end_list) 
)                                        ;   action_insert_table_J 函数结束 
 
;; 定义 绘图按钮draw 的函数    
(defun action_draw (/) 
  (setq        W_L  (get_tile "Wide_L") 
        W_L  (atof W_L) 
        W_R  (get_tile "Wide_R") 
        W_R  (* (atof W_R) -1.0) 
        mold (get_tile "scfg") 
        mold (atoi mold)                ; 加宽方式    
  ) 
 
) 
 
;;  (setq e (entlast))    (command "zoom" "e")

账号		自动登录	找回密码
密码			注册

[源码] 用交点法绘制公路曲线

本帖子中包含更多资源