本帖最后由 skg123 于 2011-5-29 11:56 编辑
谢谢大家的支持，本人结合工作实践编了 横断面数据提取程序，本程序主要是针对CASS横断面数据格式编程，程序使用方法不再在啰唆了。命令：hdmsj （CAD2004版本可以正常运行，系统在XP Ｗ７均可）
注：本程序有个漏洞是，当出现空选了，程序就自动退出本断面数据提取，进入下一断面数据提取。
优点：可以在屏幕上拾取 测量点自动计算并输出到记事本中，数据格式为CASS数据格式。可以将多个断面的数据写入同一个记事本中，方便批量绘制横断面图。（横断面成图需要借助CASS的横断面的绘图功能），当提示是否替代原有数据文件时，可以选择“是”，并不会遗失原有数据。
为了提高工作效率，请事先将数据点先展在CAD中，并绘制好道路中心线，横断面线，并标注好桩号。
捕捉设置为 “最近点”
(defun C:hdmsj();横断面数据提取程序
(setvar "cmdecho" 0)
(setq ff (open (getfiled "文件保存为" "c:/" "hdm" 1) "a"))
(or zx
(setq zx 0)
)
(princ "\n 是否添加中线参数：<0>添加;<1>不添加:<")
(princ zx)
(if (setq tmp (getreal ">: "))
(setq zx tmp)
)
(ang)
)
;;;=================
(defun zxcs()
(setq zzh (getreal"\n请输入中桩高程："))
(setq zxh (strcat "next"))
(write-line zxh ff)
(setq zzh0 (rtos zzh 2 3))
(setq zzh1 (strcat "0,"zzh0))
(write-line zzh1 ff)
(setq zzh00 (rtos (+ zzh 0.3) 2 3))
(setq zzh2 (strcat "-0.3," zzh00))
(write-line zzh2 ff)
(setq zzh00 (rtos (+ zzh 0.3) 2 3))
(setq zzh2 (strcat "0.3," zzh00))
(write-line zzh2 ff)
(setq zzh0 (rtos zzh 2 3))
(setq zzh1 (strcat "0,"zzh0))
(write-line zzh1 ff)
(setq zzh00 (rtos zzh 2 3))
(setq zzh2 (strcat "1," zzh00))
(write-line zzh2 ff)
)
;;;======================
(defun ang()
(setq pt1 (getpoint "\n拾取纵断面上的一点(纵横交点）："))
(setq x1 (car pt1))
(setq y1 (cadr pt1))
(setq pt2 (getpoint "\n拾取纵断面上的第二点（道路前进方向）："))
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq pt11 (list y1 x1))
(setq pt12 (list y2 x2))
(setq ang (angle pt11 pt12))
(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");
(if (= zx 0)(zxcs));判断是否写入中线参数
(setq xuanze (getreal"\n 1.选取下一个横断面高程点；2.选择新的切线；3.退出<1>："))
(if (= xuanze nil)(hdm))
(if (= xuanze 1 )(hdm))
(if (= xuanze 2 ) (fwjjs))
(if (= xuanze 3 )(close ff)
(princ"已经退出！"))
)
)
(prin1)
)
(prompt "**从CAD中提取高程点或（point）点坐标，* << C:hdmsj >> *输出CASS横断面（平距,高程）数据* By 罗泽钢*葛洲坝基础公司*")
(prin1)
数据格式 如下
BEGIN,32000.000 ；桩号
-2.323,24.6540 ；平距、高程，平距<0代表测点在左幅，反之亦反。
2.195,24.7610
6.654,24.7500
next ；中线线数据，方便
0,25.68 ；路面中桩高程，方便以后精确插入(粘贴)设计断面图块
0,24.68
BEGIN,32025.000
-3.116,24.6920
1.314,24.7680
5.814,24.7420
.....
本帖最后由 skg123 于 2011-5-25 13:23 编辑
早期设计的没有增加 道路中线
注意该程序再计算时，是将“测量点”投影到横断面剖面上，数据精度算是近似计算，对应土方测量来说本人认为影响不大。实际测量中也是很难保证测点在同一直线上的。这个我想大家是清楚的，因此还是可以放心使用的，对精度要求高的请慎重考虑。
(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)
修改一下就更好了：每次处理一个断面，LISP都要求指定中桩和固定的一个边桩，而不是纵断面线。因为在CAD图纸上做线路的法线很简单。或者还可以通过第三方软件计算中桩和一个边桩的坐标，和测量点一起直接展到CAD中。
另外可否加个选项，选择测量点距这个法线的容许误差，比如离这个法线垂距4米之外的就不要了。这个米数用户则自行选择。这样还可实现框选测量点。而不用一个个的点了。期待skg123的下个版本！
这么麻烦。很智能了，不要明经币更好
回复 yfanzi 的帖子
这个程序主要是在公路施工中应用，一般你可以自己先用别的程序把横断面剖面线（法线）绘制好。基本上放样后再测点，测点偏离断面距离是很小的。特殊的点可以自己判断是否抛弃。
设计之初也考虑了框选，但是ssget对高程点元素的提取好像有限制，框选还涉及到点排序的问题，很遗憾能力有限。只好用entsel了。但是entsel也是有它的优点。也希望有高手修改一下能实现框选功能，
回复 dwjb 的帖子
其实要币也是为了我以后下载人家的 东西。这是我多日的成果，大家支持一下，不要在乎那个币。我也给了没有币的会员机会，你看源代码都贴来了，呵呵。。。
，太感谢了！
有币就好了
skg123 发表于 2011-5-25 13:15 static/image/common/back.gif
早期设计的没有增加 道路中线
注意该程序再计算时，是将“测量点”投影到横断面剖面上，数据精度算是近似 ...
这个设计的挺好
有二楼建议期待下一个版本的出现
cass能自动生成横断面数据文件的，很方便。