CASS横断面提取程序，望大侠们改善改善

cgwang1023

cass里面断面提取工作是非常复杂繁琐的，这个断面提取程序可以提取，但是不太完美，望大侠们按照下面几点要求改进一下：
1、数据输出改为距离。高差；
2、输入桩号后，选择高程点可否改为选横断线，按照横断线程序找寻线附近0.3范围内的高程自动计算，一个一个选择很麻烦，也容易出错；
3、数据输出格式能否按照
  29763
4 3.68 0.35 2.54 0.87 10.89 1.35 7.92 0.88
3 4.36 -0.42 3.78 -0.68 13.88 -1.57
中桩里程  
    左端面统计个数 左边距中桩距离 高差 距离上点距离 高差.......到左边最后一个数据
    左端面统计个数 右边距中桩距离 高差 距离上点距离 高差.......到右边最后一个数据

附图 和程序 ，希望大侠们改进改进

unionsoft

用TrueTable-路桥专业版，可以批量提断面数据，非常快。
http://www.truesoftcenter.com/chs/products/truetable-road.html

f4800

非常实用的代码分析。。。多谢

gzxl

这里有个，只供参考

2. (defun c:tt ( / dist ename ept fdist file fistpt fpt gcdz i lename lept lobj lspt lst maxx maxy minx miny Name obj objname pt ptl rename rept robj rspt slen spt ss v x zpt zsdist)
   
3.   (vl-load-com)
   
4.   (while (setq ename (car (entsel "\n请选择断面线：")))
   
5.     (if ename
   
6.       (progn
   
7.         (setvar "osmode" 33)
   
8.         (setq zPt (getpoint "\n拾取断面起点：")
   
9.               zPt (list (car zPt) (cadr zPt))
   
10.         )
    
11.         (setvar "osmode" 0)
    
12.         (setq obj (vlax-ename->vla-object ename))
    
13.         (setq objname (vlax-get obj 'ObjectName ))
    
14.         (if (or (= objname "AcDbLine") (= objname "AcDbPolyline"))
    
15.           (progn
    
16.             (setq sPt (vlax-curve-getStartPoint obj)
    
17.                   ePt (vlax-curve-getEndPoint obj)
    
18.             )
    
19.             (vla-Offset (vlax-ename->vla-object ename) -0.3) ;控制中线两边
    
20.             (setq Lename (entlast)
    
21.                   Lobj   (vlax-ename->vla-object Lename)
    
22.                   Lspt   (vlax-curve-getStartPoint Lobj)
    
23.                   Lept   (vlax-curve-getEndPoint Lobj)
    
24.             )
    
25.             (vla-Offset (vlax-ename->vla-object ename) 0.3) ;控制中线两边
    
26.             (setq Rename (entlast)
    
27.                   Robj   (vlax-ename->vla-object Rename)
    
28.                   Rspt   (vlax-curve-getStartPoint Robj)
    
29.                   Rept   (vlax-curve-getEndPoint Robj)
    
30.             )
    
31.             (setq lst (list Lspt Lept Rept Rspt))
    
32.             (setq minX (apply 'min (mapcar '(lambda (x) (car x)) lst))
    
33.                   minY (apply 'min (mapcar '(lambda (x) (cadr x)) lst))
    
34.                   maxX (apply 'max (mapcar '(lambda (x) (car x)) lst))
    
35.                   maxY (apply 'max (mapcar '(lambda (x) (cadr x)) lst))
    
36.             )
    
37.             (entdel Lename) (entdel Rename)
    
38.             (command "zoom" (list minX minY) (list maxX maxY))
    
39.             (setq i -1 ss (ssget "_CP" lst '((0 . "INSERT") (2 . "GC200"))))
    
40.             (if ss
    
41.               (progn
    
42.                 (setq slen (sslength ss))
    
43.                 (repeat slen
    
44.                   (setq Name (ssname ss (setq i (1+ i))))
    
45.                   (setq pt   (cdr (assoc 10 (entget Name))))
    
46.                   (setq ptl  (cons pt ptl))
    
47.                 )
    
48.                 (setq ptl (gcd_sort ptl obj))
    
49.                 (setq fpt (car ptl))
    
50.                 (setq zsdist (distance zPt sPt)) ;线起点至断面中点的距离
    
51.                 (if (setq file (getfiled "保存数据" "D:\\K0+000" "csv" 1))
    
52.                   (progn
    
53.                     (setq file (open file "a"))
    
54.                     (write-line "距离,高程值" file)
    
55.                     (while ptl
    
56.                       (setq npt (car ptl))
    
57.                       (setq pt (vlax-curve-getClosestPointTo obj npt))
    
58.                       (setq dist (- (vlax-curve-getDistAtPoint obj pt) zsdist))
    
59.                       (setq gcdz (caddr npt))
    
60.                       (write-line (strcat (rtos dist 2 3) "," (rtos gcdz 2 3)) file)
    
61.                       (setq ptl (cdr ptl))
    
62.                     )
    
63.                     (close file)
    
64.                   )
    
65.                 )
    
66.               )
    
67.             )
    
68.           )
    
69.         )
    
70.         (setq ptl nil)
    
71.       )
    
72.     )
    
73.   )
    
74. )
    
75. (defun gcd_sort (ptl obj / lst x n)
    
76.   (if (= (type obj) 'ENAME) (setq curve (vlax-ename->vla-object obj)))
    
77.   (setq lst (mapcar '(lambda (x /) (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj x))) ptl))
    
78.   (mapcar '(lambda (n) (nth n ptl)) (vl-sort-i lst '<))
    
79. )

(defun c:tt ( / dist ename ept fdist file fistpt fpt gcdz i lename lept lobj lspt lst maxx maxy minx miny Name obj objname pt ptl rename rept robj rspt slen spt ss v x zpt zsdist)<br />   (vl-load-com)<br />   (while (setq ename (car (entsel "\n请选择断面线：")))<br />     (if ename<br />       (progn<br />         (setvar "osmode" 33)<br />         (setq zPt (getpoint "\n拾取断面起点：")<br />               zPt (list (car zPt) (cadr zPt))<br />         )<br />         (setvar "osmode" 0)<br />         (setq obj (vlax-ename->vla-object ename))<br />         (setq objname (vlax-get obj 'ObjectName ))<br />         (if (or (= objname "AcDbLine") (= objname "AcDbPolyline"))<br />           (progn<br />             (setq sPt (vlax-curve-getStartPoint obj)<br />                   ePt (vlax-curve-getEndPoint obj)<br />             )<br />             (vla-Offset (vlax-ename->vla-object ename) -0.3) ;控制中线两边<br />             (setq Lename (entlast)<br />                   Lobj   (vlax-ename->vla-object Lename)<br />                   Lspt   (vlax-curve-getStartPoint Lobj)<br />                   Lept   (vlax-curve-getEndPoint Lobj)<br />             )<br />             (vla-Offset (vlax-ename->vla-object ename) 0.3) ;控制中线两边<br />             (setq Rename (entlast)<br />                   Robj   (vlax-ename->vla-object Rename)<br />                   Rspt   (vlax-curve-getStartPoint Robj)<br />                   Rept   (vlax-curve-getEndPoint Robj)<br />             )<br />             (setq lst (list Lspt Lept Rept Rspt))<br />             (setq minX (apply 'min (mapcar '(lambda (x) (car x)) lst))<br />                   minY (apply 'min (mapcar '(lambda (x) (cadr x)) lst))<br />                   maxX (apply 'max (mapcar '(lambda (x) (car x)) lst))<br />                   maxY (apply 'max (mapcar '(lambda (x) (cadr x)) lst))<br />             )<br />             (entdel Lename) (entdel Rename)<br />             (command "zoom" (list minX minY) (list maxX maxY))<br />             (setq i -1 ss (ssget "_CP" lst '((0 . "INSERT") (2 . "GC200")))) <br />             (if ss<br />               (progn<br />                 (setq slen (sslength ss))<br />                 (repeat slen<br />                   (setq Name (ssname ss (setq i (1+ i))))<br />                   (setq pt   (cdr (assoc 10 (entget Name))))<br />                   (setq ptl  (cons pt ptl))<br />                 )<br />                 (setq ptl (gcd_sort ptl obj))<br />                 (setq fpt (car ptl))<br />                 (setq zsdist (distance zPt sPt)) ;线起点至断面中点的距离<br />                 (if (setq file (getfiled "保存数据" "D:\\K0+000" "csv" 1))<br />                   (progn<br />                     (setq file (open file "a"))<br />                     (write-line "距离,高程值" file)<br />                     (while ptl<br />                       (setq npt (car ptl))<br />                       (setq pt (vlax-curve-getClosestPointTo obj npt))<br />                       (setq dist (- (vlax-curve-getDistAtPoint obj pt) zsdist))<br />                       (setq gcdz (caddr npt))<br />                       (write-line (strcat (rtos dist 2 3) "," (rtos gcdz 2 3)) file)<br />                       (setq ptl (cdr ptl))<br />                     )<br />                     (close file)<br />                   )<br />                 )<br />               )<br />             )<br />           )<br />         )<br />         (setq ptl nil)<br />       )<br />     )<br />   )<br /> )<br /> (defun gcd_sort (ptl obj / lst x n)<br />   (if (= (type obj) 'ENAME) (setq curve (vlax-ename->vla-object obj)))<br />   (setq lst (mapcar '(lambda (x /) (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj x))) ptl))<br />   (mapcar '(lambda (n) (nth n ptl)) (vl-sort-i lst '<))<br /> )

cgwang1023

gzxl 发表于 2013-11-17 21:54
这里有个，只供参考

谢谢gzxl，我刚试了一下，因为图上横断面比较多，每次要提取个文件是不是很麻烦，可以提取到一个文件里面吗，还有就是提取的数据要求是距离、高差形式的

gzxl

cgwang1023 发表于 2013-11-17 22:11
谢谢gzxl，我刚试了一下，因为图上横断面比较多，每次要提取个文件是不是很麻烦，可以提取到一个文件里面 ...

画图绘图寻找懒的方法，同意
改代码您总不能懒了吧

cgwang1023

我从其他地方看到你原来有个程序，怎么现在找不到了，能再给我发一个吗，50056697@qq.com
安装后界面在附件里

cgwang1023

gzxl 发表于 2013-11-17 22:29
画图绘图寻找懒的方法，同意
改代码您总不能懒了吧

我不会这些，看不懂代码，只是在中专里面学了一点，那都是十几年前了，早忘记了。

ann2008

可以考虑批量提取比较方便，顺便加上标注桩号和画出断面线就完美了呵呵

skg123

我做hdm0的时候，当时是应用在公路上提取断面数据。测点要在 断面线0.3m范围内实际操作中很难做到（障碍物太多）；所有挨个点取高程点（人工判断）；你想把 统计格式写前面，我的这个程序不能修改实现，数据书写的顺序不同，我的是先计算后统计可以，你想先统计后计算，不好修改；我好想对纬地的数据格式理解错了，我没有用过纬地软件，只看过数据格式；

wzb0113

像你推荐一款软件“灵宇断面”，可以在图上拾取横断面，横断面的数据用复合线连起来，复合线里面的高程都能生成断面数据，但是数据格式和纬地的不一样，要你自己在纬地里面转换为纬地格式。

yxh1202

gzxl 发表于 2013-11-17 21:54
这里有个，只供参考

这个提取的是横断面吗