明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1684|回复: 0

请教各位

[复制链接]
发表于 2012-5-28 12:03:59 | 显示全部楼层 |阅读模式
各位朋友,我这里有个程序,运行不了,可以帮忙修改修改啊,是一个关于公路缓和曲线的
/*      《具有缓和曲线的圆曲线计算》数据输入对话框设计 (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》 程序结束 !
  

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-22 03:52 , Processed in 0.249169 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表