横断面数据提取
;;;本程序命令为hdmout,仅针对图纸比例为1：1的情况而言，若比例不是1：1，请自行调整图纸比例
;;;本程序需选择断面桩号、坐标系基准中心、选择基准中心处的断面高程数据
;;;本程序所获得的数据为追加形式，一次采取一条断面，可以累加
(defun c:hdmout (/ s filename e n fn jd pt pts number str_1)
(vl-load-com)
(setq str_1 (cdr (assoc 1(entget (car (entsel "请选择一个断面桩号："))))))
(setq point_1 (getpoint "\n 请选择坐标系基准中心位置"))
(setq px_1 (car point_1)
py_1 (cadr point_1))
(setq e55 (cdr (assoc 1 (entget (car (entsel "\n 请选取该断面的中心高程数据:"))))))
(setq bb (vl-string->list e55))
(setq cc (vl-remove-if '(lambda (x) (> x 57)) bb))
(setq de (vl-remove-if '(lambda (x) (< x 43)) cc))
(setq height_1 (atof (vl-list->string de)))
(if (setq s (ssget ":S" '((0 . "*POLYLINE")))) ;_点选带过滤形式
(progn
(setq e (ssname s 0)
number (fix (vlax-curve-getendparam e))
n (+ 1 number)
)
(if (not (setq filename
(getfiled "选择文件存储目录" "d:/断面线数据.txt" "txt" 33)
)
)
(setq filename "c:\\断面线数据.txt")
)
(setq fn (open filename "a")
jd n
)
(WRITE-LINE str_1 fn)
(setvar "dimdec" 3)
(repeat n
(setq pt (vlax-curve-getpointatparam e (setq jd (1- jd))))
(if (null pts)
(setq pts (list pt))
(if (not (equal pt (car pts) 1e-3))
(setq pts (cons pt pts))
)
)
)
(setq n 1)
(mapcar '(lambda (x)
(write-line
(strcat (itoa n)
","
(rtos (- (car x) px_1))
","
(rtos (+ height_1 (- (cadr x) py_1))) ;_与前面的 dimzin 配合采用用户 UNITS 精度设置
)
fn
)
(setq n (1+n))
)
pts
)
(close fn)
)
)
(princ"\n")
)
谢谢楼上
各位如有什么好建议，请说明一下，以便改正。 断面一般都是左负右正，如果能完善批量选择横断图再根据中线里程来提取高程点数据就完美了 断面一般都是左负右正，如果能完善批量选择横断图再根据中线里程来提取高程点数据就完美了 无详细帮助，不会用，大哥来个帮助或者动画 先收藏了。。。 本帖最后由 yshf 于 2011-9-18 13:00 编辑
不能处理首尾相接的多条直线、多段线或直线与多段线的组合，由于跟绘图时的先后顺序有关，提取的断面数据中，有的断面是自左向右，有的断面自右向左，不尽统一。 建议如下：
1.断面线应该输出的是图上自左到右的顺序，意即左正右负，符合一般的习惯
2.能加个选项就好了，选择保存为 1纬地格式2CASS格式3自定义格式（就是楼主程序自带的格式）
还是支持楼主的源码！ 不知道怎么用 楼主，高程点是 类型的，CASS中的高程点不能用，显示数据类型错误 有些复杂了，感觉 yfanzi 发表于 2011-9-19 20:38 static/image/common/back.gif
建议如下：
1.断面线应该输出的是图上自左到右的顺序，意即左正右负，符合一般的习惯
2.能加个选项就好了 ...
“意即左正右负”
大家是习惯左正右负 ，还是左负？
我习惯左负