《求助》lsp程序如何从地形图上提取断面数据？

skg123

    我现在已经测量了公路的一些原始地形数据，并且把数据通过CASS展到了CAD中；

现在需要绘制道路的横断面图。如果采用手工量取散点到道路中线的垂直距离，工作量那是相当的大（公路有20多公里）；

我现在大家能帮我发个程序，能够够从地形图上直接选取 某个断面上的N 个散点到道路中心线的距离及高程；将结果输出到文本中，输出格式为 （距离，高程）的样式

数据格式如下

距离，高程   '注释

-10.120, 23.265
-9.824,21.765
-3.514,18.135
0.524,14.135
7.524,15.685
8.545,13.735
10.214,12.414

距离保留3位小数，高程保留3位小数；

距离小于0代表散点位于中线的左边，大于0代表在线的右边，0代表在线上，高程就直接提取散点的高程；

我希望实现才操作步骤是：运行程序后 1、提示输入道路中线上的第一个点，=>2、提示输入道路中线上的第二个点（可以图上拾取坐标） 这样可以作为判断地形点位于线的那个方向（左、右）的依据

=>3、提示数据保存的位置及名称=》4、选择该断面上散点（通过屏幕选取）=》5、 打开数据文件=》完毕  核对数据后进行下一个断面数据计算；

不知道有没有表达清楚，有不懂的可以跟帖，我再补充，我想这个问题做路桥工程的同仁们一定很需要解决，希望有这方面程序的网友上传一个，不胜感激！

 

skg123

回复 dwjb 的帖子

其实要币也是为了我以后下载人家的 东西。这是我多日的成果，大家支持一下，不要在乎那个币。我也给了没有币的会员机会，你看源代码都贴来了，呵呵。。。

skg123

早期设计的没有增加　道路中线
注意该程序再计算时，是将“测量点”投影到横断面剖面上，数据精度算是近似计算，对应土方测量来说本人认为影响不大。实际测量中也是很难保证测点在同一直线上的。这个我想大家是清楚的，因此还是可以放心使用的，对精度要求高的请慎重考虑。
(defun C:hdm0()
(setvar "cmdecho" 0)
(setq ff (open (getfiled "文件保存为" "c:/" "hdm" 1) "a"))
(fwjjs)
)
(defun fwjjs()
;计算方位角子程序
(setvar "cmdecho" 0) ;指令执行过程不响应
(setq pt1 (getpoint "\n拾取纵断面上的一点："));用于确定横断面上的零点位置
(setq x1 (car pt1));给纵断面上一点X赋值x1
(setq y1 (cadr pt1));给纵断面上一点Y赋值y1
(setq pt2 (getpoint "\n拾取纵断面上的第二点："));用于确定横断面上的零点位置
(setq x2 (car pt2));给纵断面上一点X赋值x1
(setq y2 (cadr pt2));给纵断面上一点Y赋值y1
;计算纵断面（pt1->pt2）方位角
(setq j1 (atan (/(- y2 y1) (+ (- x2 x1) 0.0000001))));弧度值
(setq j2 (/(* j1 180) pi))
(if (>(- x2 x1) 0)(setq sgn 1));符号判断
(if (=(- x2 x1) 0)(setq sgn 0))
(if (<(- x2 x1) 0)(setq sgn -1))
(setq fwj (+ (- 180(* 90 sgn) j2)));方位角计算
(setq ang (/(* fwj pi) 180))
(hdm)
)

;拾取高程点进行平距计算
(defun hdm()
(setvar "cmdecho" 0) ;指令执行过程不响应
(setq zh (getreal"\n请输入桩号："))
(setq zh1 (rtos zh 2 3))
(setq zh2 (strcat "BEGIN," zh1))
(write-line zh2 ff)

(while (setq en (entsel "\n选择高程点:"))
(setvar "cmdecho" 0)
(redraw (car en) 3)
(setq en_data (entget (car en))) ;取得元体资料列表
(setq pt (cdr (assoc 10 en_data))) ;求得高程点坐标pt
(setq py (nth 0 pt));提取测量坐标系Y值
(setq px (nth 1 pt));提取测量坐标洗X值

(setq cj (-(* (- py x1) (cos ang)) (* (- px y1) (sin ang))));该行要注意数学坐标与测量坐标的互换计算垂直距离（cj）
(setq dist (rtos cj 2 3))
(setq pz(rtos (nth 2 pt)2 3));提取测量坐标系Z值
(setq pdz (strcat dist","pz));输出为CASS数据格式（平距,高程）
(write-line pdz ff);写入文本
(princ pdz)
)
(while (/= 52 (getvar "cmdactive");
(setq xuanze (getreal"\n 1.选取下一个横断面高程点；2.选择新的切线；3.退出<1>："))
(if (= xuanze nil)(hdm))
(if (= xuanze 1 )(hdm))
(if (= xuanze 2 ) (fwjjs))
(if (= xuanze 3 )(princ"已经退出！"))
)
)
(prin1)
)
(prompt "**从CASS中提取高程点或（point）点坐标，* << C:open_ff >> *输出横断面（平距,高程）数据**")
(prin1)

gzxl

(defun c:dmsj( / cur dis ff pt pt1 pz pzz)
   (setvar "cmdecho" 0)
   (setq ff (getfiled "" "断面数据" "csv" 1))
   (setq ff (open ff "a"))
   (setq PL (entsel "\n选择PL线:"))
   (setq PL (vlax-ename->vla-object (car PL)))
   (setq pt1 (getpoint "\n拾取断面起点："))
   (write-line "起点距,高程,备注" ff)
   (while
       (setq pt (getpoint "\n选择断面高程点："))
       (setq pz (caddr pt))
       (setq pzz (rtos pz 2 2))
       (setq dis
            (strcat
                (rtos (abs (- (vlax-curve-getdistatparam
                                PL
                                (vlax-curve-getparamatpoint
                                  PL
                                  (vlax-curve-getclosestpointto PL pt1)
                                )
                              )
                              (vlax-curve-getdistatparam
                                PL
                                (vlax-curve-getparamatpoint
                                  PL
                                  (vlax-curve-getclosestpointto PL pt)
                                )
                              )
                           )
                      )
                      2
                )
            )
       )
       (write-line (strcat dis "," pzz) ff)
   )
   (close ff)
   (princ)
 )

jzj-fx72

顶起，重要

skg123

经过我的几天努力，现在已经解决了这个问题，还有部分需要修改的地方。改好了与大家分享

wzb0113

想要这个软件。

zark

CASS本身就带有这个功能

wzb0113

CASS选择断面不能图上手动拾取高程。

gzbccy

gzxl,不好意思，用了你的程序，但是没法用啊，或者你的程序太高深，我没用会？
麻烦你告诉一下？加载程序后出现; 错误: 参数类型错误: numberp: ni
然后命令无法使用l

gzbccy

回复 gzxl 的帖子

用了你的程序，但是没法用啊，或者你的程序太高深，我没用会？
麻烦你告诉一下？加载程序后出现; 错误: 参数类型错误: numberp: ni
然后命令无法使用l

yjpzc

http://bbs.mjtd.com/thread-85210-1-2.html