请教各位
各位朋友，我这里有个程序，运行不了，可以帮忙修改修改啊，是一个关于公路缓和曲线的/* 《具有缓和曲线的圆曲线计算》数据输入对话框设计 （DCL语言） */
Ecurve:dialog{label=" 《具有缓和曲线的圆曲线》计算数据输入";
:text{label="（一）输入道路中线已知数据：";}
:edit_box{label=" 道路中线交点桩号PNJD(m):";key="PNjd";
edit_limit=20;edit_width=10;value="0";}
:row{
:edit_box{label=" 后视转点横坐标XB(m):";key="Xb";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 后视转点纵坐标YB(m):";key="Yb";
edit_limit=20;edit_width=10;value="0";}
}
:row{
:edit_box{label=" 路线交点横坐标XJ(m):";key="Xj";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 路线交点纵坐标YJ(m):";key="Yj";
edit_limit=20;edit_width=10;value="0";}
}
:row{
:edit_box{label=" 前视转点横坐标XF(m):";key="Xf";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 前视转点纵坐标YF(m):";key="Yf";
edit_limit=20;edit_width=10;value="0";}
}
:text{label="（二）输入道路中线设计数据：";}
:row{
:edit_box{label=" 圆曲线设计半径R(m): ";key="R";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 缓和曲线设计长Ls(m):";key="Ls";
edit_limit=20;edit_width=10;value="0";}
}
:row{
:edit_box{label=" 缓和曲线分段长 LN(m):";key="LN";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 圆曲线的分段长CN(m):";key="CN";
edit_limit=20;edit_width=10;value="0";}
}
:row{
:edit_box{label=" 设计道路半宽度D(m): ";key="D";
edit_limit=20;edit_width=10;value="0";}
:edit_box{label=" 图中注记文字高(mm): ";key="S2";
edit_limit=20;edit_width=10;value="0";}
}
:edit_box{label="（三）指定输出曲线测设数据的文件名 ( *.txt )";key="DataFile";
edit_limit=20;edit_width=10;value=".txt";}
ok_cancel;
}
;------------------------------------------------------------------------
; LISP Program《ECURVE1》for calculating and drawing easement-circle
;-curve,including their parallels and output parameters & coordinates
; 具有缓和曲线的圆曲线中桩和边桩的计算、绘图和测设数据输出
; （用对话框输入起始数据） (2005.08.02)
;------------------------------------------------------------------------
; 子程序--从编辑框取值
(defun getile() ; 从编辑框取值均为字符串，除"数据文件名"外需化为实数
(setq PNJd (atof (get_tile "PNjd"))); get_tile从关键字为代表对话框取值
(setq Xb (atof (get_tile "Xb")) Yb (atof (get_tile "Yb")))
(setq Xj (atof (get_tile "Xj")) Yj (atof (get_tile "Yj")))
(setq Xf (atof (get_tile "Xf")) Yf (atof (get_tile "Yf")))
(setq R(atof (get_tile "R"))Ls (atof (get_tile "Ls")))
(setq LN (atof (get_tile "LN")) CN (atof (get_tile "CN")))
(setq D(atof (get_tile "D"))S2 (atof (get_tile "S2")))
(setq DataFile (get_tile "DataFile"))
)
; 主程序--缓和曲线的计算、绘图与数据输出
(defun c:ecurve1(/ PNJd Xb Yb Xj Yj Xf Yf R Ls LN LC D S2 DataFile id)
; 从对话框读入计算所需起始数据：
(setq id (load_dialog "Ecurve.dcl")) ; 加载DCL程序于内存，并获标识码id
(if (< id 0) (exit)) ; 如果加载不成功则退出
(if (not (new_dialog "Ecurve" id)) (exit))
(setq PNjd 0 Xb 0 Yb 0 Xj 0 Yj 0 Xf 0 Yf 0 R 0 Ls 0 LN 0 LC 0 D 0
S2 0 Datafile ".txt") ; 程序中的变量赋初值
(action_tile "accept" "(getile) (done_dialog 1)")
; 当"确定"(accept)按钮按下，控件的指定动作为getile及done_dialog
(start_dialog) ; 显示对话框,经数据输入,按"确定"按钮, 送入主程序
(unload_dialog id) ; 对话框任务完成，将DCL文件从内存中下载
; 初步计算：
(setq S3 (/ S2 3)) ; 注记点位名离点位的坐标差
(setq N (fix (1+ (/ Ls LN)))) ; N 为缓和曲线分段数
(setq F (open DataFile "w")) ; 打开数据文件写入
(setq BD (list Xb Yb) JD (list Xj Yj) FD (list Xf Yf)) ;形成两维点位表
(setq BD1 (list (+ Xb S3) (+ Yb S3)) FD1 (list (+ Xf S3) (+ Yf S3)))
(setq JD1 (list (+ Xj S3) (+ Yj S3)))
(setq JD2 (list (- Xj S2) (+ Yj S3)))
; 画道路中线交点及前后转点：
(command "style" "standard" "宋体" "" "" "" "n" "n" "a" "c" "") ; 字体
(command "pdmode" 32 "pdsize" 0.6 "") ; 指定画点的模式和大小
(command "point" JD "") (command "text" JD1 S2 0 "JD" "") ; 画路线交点
(command "point" BD "") (command "text" BD1 S2 0 "ZD(b)" ""); 前视转点
(command "point" FD "") (command "text" FD1 S2 0 "ZD(f)" ""); 后视转点
; 求交点至前后视转点及曲中点方位角(用求值函数-angle)和计算路线偏角：
(setq Ab (angle JD BD) bA (angle BD JD))
(setq Af (angle JD FD) fA (angle FD JD))
(setq Am (/ (+ Ab Af) 2)) ;计算分角线的方位角
(if (or (and (< (- Ab Af) PI) (> (- Ab Af) 0)) (< (- Ab Af) (* PI -1)))
(setq LR 1) (setq LR 2)) ;判断路线方向的左右偏,LR=1左偏,LR=2右偏
(if (and (= LR 1) (> Af Ab)) (setq Am (+ Am PI)))
(if (and (= LR 2) (< Af Ab)) (setq Am (+ Am PI)))
(if (and (= LR 1) (> (- Af bA) 0))(setq A (- Af bA))) ;计算左偏角
(if (and (= LR 1) (> (- bA Af) PI)) (setq A (+ (- Af bA) (* PI 2))))
(if (and (= LR 2) (> (- bA Af) 0))(setq A (- bA Af))) ;计算右偏角
(if (and (= LR 2) (> (- Af bA) PI)) (setq A (+ (- bA Af) (* PI 2))))
; 计算缓和曲线辅助参数：
(setq M (- (/ Ls 2) (/ (* Ls Ls Ls) (* 240 R R)))) ; 计算 m,p,βo
(setq P (/ (* Ls Ls) (* 24 R)) B0 (/ Ls (* 2 R)))
; 计算缓和曲线和圆曲线元素：
(setq Lc (* R (- A (* 2 B0))) L (+ Lc (* 2 Ls)) L2 (/ L 2)) ;计算 Lc
(setq A2 (/ A 2) TA2 (/ (sin A2) (cos A2))); 计算tanα/2,因LISP无tan
(setq TT (+ M (* (+ R P) TA2))) ;计算切线长 T 及外矢距 E
(setq EE (- (/ (+ R P) (cos A2)) R))
; 计算曲线主点坐标：
(setq ZH (polar JD Ab TT));用极坐标求值函数-polar,计算直缓点大地坐标
(setq QZ (polar JD Am EE)) ;计算曲中点大地坐标
(setq HZ (polar JD AF TT)) ;计算援直点大地坐标
; 计算缓圆点和圆缓点法线方位角及大地坐标：
(setq Ye (/ (* Ls Ls) (* 6 R)) Xe (- Ls (/ (expt Ls 3) (* 40 R R))))
(if (= LR 1) (setq A01 (- Ab (/ PI 2)) A02 (+ Af (/ PI 2)))
(setq A01 (+ Ab (/ PI 2)) A02 (- Af (/ PI 2)))) ;ZH,HZ点法线方位角
(setq HY0 (polar ZH bA Xe)) (setq HY (polar HY0 A01 Ye)); HY大地坐标
(setq YH0 (polar HZ fA Xe)) (setq YH (polar YH0 A02 Ye)); YH大地坐标
(setq ZH1 (polar ZH (/ PI 6) S3) ZH2 (polar ZH PI S2)) ;算注记起点坐标
(setq QZ1 (polar QZ (/ PI 6) S3) QZ2 (polar QZ PI S2))
(setq HZ1 (polar HZ (/ PI 6) S3) HZ2 (polar HZ PI S2))
(setq HY1 (polar HY (/ PI 6) S3) HY2 (polar HY PI S2))
(setq YH1 (polar YH (/ PI 6) S3) YH2 (polar YH PI S2))
; 画曲线主点：
(command "layer" "m" "曲线主点" "c" "red" "" "") ;建道路曲线主点图层
(command "point" ZH "") (command "text" ZH1 S2 0 "ZH" "");画曲线起点
(command "point" QZ "") (command "text" QZ1 S2 0 "QZ" "") ; 中点
(command "point" HZ "") (command "text" HZ1 S2 0 "HZ" "") ; 终点
(command "point" HY "") (command "text" HY1 S2 0 "HY" "") ; 缓圆点
(command "point" YH "") (command "text" YH1 S2 0 "YH" "") ; 圆缓点
; 计算曲线主点桩号：
(setq PNzh (- PNjd TT) PNqz (+ PNzh L2) PNhz (+ PNzh L))
(setq PNhy (+ PNzh Ls) PNyh (- PNhz Ls))
; 以下用实数转字符函数-rtos注记桩号,取 2 位小数
(setq Pzh (rtos PNzh 2 2) Pqz (rtos PNqz 2 2) Phz (rtos PNhz 2 2))
(setq Pjd (rtos PNjd 2 2) Phy (rtos PNhy 2 2) Pyh (rtos PNyh 2 2))
(setq rtoa (/ 180 PI)); 用弧角转换函数-rtoa,将方位角弧度化为角度(度)
(setq Az (* rtoa (+ Ab (/ PI 2))))
(setq Ah (* rtoa (- Af (/ PI 2))))
(setq Aq (* rtoa Am))
; 注记曲线主点桩号：
(command "layer" "m" "桩号" "c" "yellow" "" "") ;建立桩号注记图层
(command "text" ZH2 S2 Az Pzh) ;注记交点起点中点终点缓圆点桩号
(command "text" HZ2 S2 Ah Phz) (command "text" QZ2 S2 Aq Pqz)
(command "text" JD2 S2 (+ Aq 180) Pjd)
(command "text" HY2 S2 Az Phy) (command "text" YH2 S2 Ah Pyh)
(command "zoom" "e" "")
; 曲线元素及主点桩号计算的文件输出：
(princ " 缓和曲线文件名: " F) (princ Datafile F) (princ "\n" F)
(princ "\n" F) (princ " 道路转点坐标(y,x): " F) (princ "\n" F)
(princ " ZD(b) " F) (princ BD F) (princ "JD " F) (princ JD F)
(princ "ZD(F) " F) (princ FD F) (princ "\n" F)
(princ "\n" F) (princ " 曲线设计数据: " F) (princ "R = " F)
(princ R F) (princ " Ls = " F) (princ Ls F)
(princ "\n" F) (princ "\n" F)
(princ " 曲线计算数据: " F) (princ "α= " F)
(princ (angtos A 1 4) F)
(princ " m = " F) (princ M F) (princ " p = " F) (princ P F)
(princ " T = " F) (princ TT F) (princ "\n" F)
(princ " E = " F) (princ EE F) (princ " Lc = " F)
(princ Lc F) (princ " L = " F) (princ L F)
(princ "βo = " F) (princ (angtos B0 1 4) F) (princ "\n" F)
(princ "\n" F)
(princ " 曲线主点桩号及坐标(y,x): " F) (princ "\n" F)
(princ " ZH:" F) (princ Pzh F) (Princ " " F) (princ ZH F)
(princ "\n" F)
(princ " HY:" F) (princ Phy F) (Princ " " F) (princ HY F)
(princ "\n" F)
(princ " QZ:" F) (princ Pqz F) (Princ " " F) (princ QZ F)
(princ "\n" F)
(princ " YH:" F) (princ Pyh F) (Princ " " F) (princ YH F)
(princ "\n" F)
(princ " HZ:" F) (princ Phz F) (Princ " " F) (princ HZ F)
(princ "\n" F) (princ "\n" F)
; 画道路中线的切线和圆曲线：
(command "layer" "m" "路线切线" "c" "4" "" "")
(command "line" BD JD FD "")
(command "layer" "m" "圆曲线" "c" "1" "圆曲线" "")
(command "arc" HY QZ YH"")
; 缓和曲线(一)细部点及边线点计算坐标,输送至文件和画点位：
(princ " 缓和曲线(一)细部点桩号及中桩和左、右边桩坐标(y,x): " F)
(princ "\n" F)
(setq LEi 0 BF 1 Origin ZH A0 bA); 开始以直缓点为原点,切线为起始方向
(setq PNi PNzh); 桩号(PN)从直缓点开始,逐点增加,"i"代表缓和曲线上的点
(repeat N
(setq Xi (- LEi (/ (expt LEi 5) (* 40 (* R R) (* Ls Ls)))))
(setq Yi (/ (expt LEi 3) (* 6 R Ls))) ; 计算独立坐标
(if (or (and (= BF 1) (= LR 2)) (and (= BF 2) (= LR 1)))
(setq Yi (* Yi -1)))
(setq Bi (/ (* LEi LEi) (* 2 R Ls))) (if (= LR 2) (setq Bi (* Bi -1)))
(setq Ari (+ A0 Bi (/ PI 2))) ;计算缓和曲线点i曲率半径方位角
; 将独立坐标变换为大地坐标
(setq XXi (+ (nth 0 Origin) (- (* Xi (cos A0)) (* Yi (sin A0)))))
(setq YYi (+ (nth 1 Origin) (+ (* Yi (cos A0)) (* Xi (sin A0)))))
(setq I (list XXi YYi))
(setq Li (polar I Ari D) Ri (polar I (+ Ari PI) D));计算左右边桩点位
(setq Eback (cons I Eback)) ; 将缓和曲线(一)的细部点放入点表-Eback
; 画缓和曲线的中线点及边桩点：
(command "layer" "m" "曲线细部点" "c" "green" "" "")
(command "point" I "") (command "point" Li "") (command "point" Ri "")
; 缓和曲线细部点坐标计算的文件输出：
(princ " " F) (princ PNi F) (princ " " F) (princ I F)
(princ " " F) (princ Li F) (princ " " F) (princ Ri F)
(princ "\n" F)
(setq LEi (+ LEi LN) PNi (+ PNi LN));点号增大,曲线点的计算长度也增大
) ; End repeat
(setq Eback (reverse Eback)) ; 用样条曲线画缓和曲线,点表中元素倒序排列
(command ".layer" "m" "缓和曲线" "c" "magenta" "缓和曲线" "")
(command "spline" ZH) (setq i 1) ; 从直缓点开始画
(repeat (- N 1) ; 从缓和曲线点表中依次取出各点画缓和曲线
(setq Pt (nth i Eback)) (command Pt) (setq i (+ i 1))
) ; End repeat
(command "" "" "" "") ; 结束画缓和曲线(一)
; 圆曲线细部点及边线点计算坐标,输送至文件和画点位：
(princ "\n" F)
(princ " 圆曲线细部点桩号及中桩和左右边桩坐标(y,x): " F) (princ "\n" F)
(setq PNj 0 ) ; 开始计算圆曲线上细部点(整桩)桩号,"j"代表圆曲线上的点
(setq PN0 (rem PNhy CN) PN1 (- CN PN0) PNj (+ PNhy PN1));用求余函数rem
; 求缓圆点前整桩距PN0,后整桩距PN1,在计算圆曲线上第一个整桩号PNj
(setq LCj (- PNj PNzh)) ; 计算整桩至直缓点距离(起点距)
(while (< PNj PNyh)
(setq Bj (+ B0 (/ (- LCj Ls) R))) ; 计算圆曲线点的独立坐标
(setq Xj (+ (* R (sin Bj)) M))
(setq Yj (+ (* R (- 1 (cos Bj))) P))
(if (or (and (= BF 1) (= LR 2)) (and (= BF 2) (= LR 1)))
(setq Yj (* Yj -1)))
(setq Aj (+ B0 (/ (- LCj Ls) R))) (if (= LR 2) (setq Aj (* Aj -1)))
(setq ARi (+ A0 Aj (/ PI 2))) ;计算圆曲线点j的曲率半径方位角
; 将独立坐标变换为大地坐标
(setq XXj (+ (nth 0 Origin) (- (* Xj (cos A0)) (* Yj (sin A0)))))
(setq YYj (+ (nth 1 Origin) (+ (* Yj (cos A0)) (* Xj (sin A0)))))
(setq J (list XXj YYj))
(setq Lj (polar J ARi D) Rj (polar J (+ ARi PI) D));计算左右边桩点位
; 画圆曲线的中线点及边桩点：
(command ".layer" "m" "曲线细部点" "")
(command "point" J "") (command "point" Lj "") (command "point" Rj "")
; 圆曲线细部点坐标计算的文件输出：
(princ " " F) (princ PNj F) (princ " " F) (princ J F)
(princ " " F) (princ Lj F) (princ " " F) (princ Rj F)
(princ "\n" F)
(setq LCj (+ LCj CN) PNj (+ PNj CN)) ; 起点距及桩号均增加一个桩距
) ; End while
; 缓和曲线(二)细部点及边线点计算坐标,输送至文件和画点位：
(princ "\n" F)
(princ " 缓和曲线(二)细部点桩号及中桩和左、右边桩坐标(y,x): " F)
(princ "\n" F)
(setq LEi Ls BF 2 Origin Hz A0 fA) ; 开始以缓直点为原点,切线为起始方向
(setq PNi PNyh) ; 桩号从圆缓点开始,逐点增加
(repeat N
(setq Xi (- LEi (/ (expt LEi 5) (* 40 (* R R) (* Ls Ls)))))
(setq Yi (/ (expt LEi 3) (* 6 R Ls)))
(if (and (= BF 2) (= LR 1)) (setq Yi (* Yi -1)))
(setq Bi (/ (* LEi LEi) (* 2 R Ls))) (if (= LR 1) (setq Bi (* Bi -1)))
(setq Ari (+ A0 Bi (/ PI 2))) ;计算缓和曲线点i曲率半径的方位角
; 将独立坐标变换为大地坐标
(setq XXi (+ (nth 0 Origin) (- (* Xi (cos A0)) (* Yi (sin A0)))))
(setq YYi (+ (nth 1 Origin) (+ (* Yi (cos A0)) (* Xi (sin A0)))))
(setq I (list XXi YYi))
(setq Ri (polar I Ari D) Li (polar I (+ Ari PI) D));计算左右边桩点
(setq Efore (cons I Efore)) ; 将缓和曲线(二)的细部点放入点表-Efore
; 画缓和曲线的中线点及边桩点：
(command "layer" "m" "曲线细部点" "c" "green" "" "")
(command "point" I "") (command "point" Li "") (command "point" Ri "")
; 缓和曲线细部点坐标计算的文件输出：
(princ " " F) (princ PNi F) (princ " " F) (princ I F)
(princ " " F) (princ Li F) (princ " " F) (princ Ri F)
(princ "\n" F)
(setq LEi (- LEi LN) PNi (+ PNi LN)) ; 点号增大,曲线点的计算长度减小
) ; End repeat
(setq Efore (reverse Efore)) ; 用样条曲线画缓和曲线,点表中元素倒序排列
(command "layer" "m" "缓和曲线" "c" "magenta" "" "")
(command "spline" YH) (setq i 1) ; 从圆缓点开始画
(repeat (- N 1) ; 从缓和曲线点表中依次取出各点画缓和曲线
(setq Pt (nth i Efore)) (command Pt) (setq i (+ i 1))
) ; End repeat
(command "" "" "" "") ; 结束画缓和曲线(二)
(setq Eback nil Efore nil) ; 清空点表可继续算另一条道路曲线
(princ)
) ; 《ECURVE1》 程序结束 !
页:
[1]