高程与坐标

107627ZJ

指定起点按照顺序一次性提取多段线各端点高程及坐标

newbuser

从网上搜了个获取三维多段线顶点坐标高程的函数，希望对你有用。

2. (Defun ayGetPolyLineVTX        (LwPolyEntName /      entData1            entName1
   
3.                          pel        ptp    wpl    wpll   plp    par
   
4.                          ct        pen    rl     pn     clk    pt
   
5.                          al        gx     bj     np     xc            gg
   
6.                          rr        cp     retList
   
7.                         )
   
8.   (setq entName1 LwPolyEntName)
   
9.   (setq retList nil)
   
10.   (setq entData1 (entget entName1))
    
11.   (if (= "POLYLINE" (Cdr (Assoc 0 entData1)))
    
12.     (progn
    
13.       (setq pel             entData1                ;取出对象表.
    
14.             ptp             (Cdr (Assoc 70 pel)) ;取出结束片段型.
    
15.             wpl             '()                ;自建的点位数表.
    
16.             wpll     '()
    
17.             entName1 (EntNext entName1)
    
18.             pen             entName1
    
19.       )                                        ;end_setq
    
20.       (While (/= "SEQEND" (Cdr (Assoc 0 (entget pen)))) ;如果没束.
    
21.         (setq pel  (entget pen)                ;取得顶点对象数据表.
    
22.               plp  (Cdr (Assoc 10 pel))        ;取出控制点点位.
    
23.               par  (Cdr (Assoc 42 pel))        ;取出弓弦比.
    
24.               wpl  (Cons (List plp par) wpl) ;将数据加到WPL表中.
    
25.               wpll (cons plp wpll)
    
26.         )                                ;end_setq
    
27.         (setq pen (EntNext pen))        ;搜索下一个对象.
    
28.       )                                        ;end_while
    
29.       (setq wpll (Reverse wpll))
    
30.                                         ;以下代码暂时没有用！
    
31.       (setq ct (If (= 0 (Cadr (Car wpl)))
    
32.                  "直线片段封闭"
    
33.                  "弧片段封闭"
    
34.                )
    
35.       )
    
36.       (setq wpl        (Cons (Last wpl) wpl)        ;加入封闭点.
    
37.             wpl        (Reverse wpl)                ;整理WPL表.
    
38.             rl        (Length wpl)
    
39.             pn        0
    
40.       )                                        ;end_setq
    
41.       (setq clk        (If (Or (= 0 ptp) (= 128 ptp))
    
42.                   "开口"
    
43.                   "封闭"
    
44.                 )
    
45.       )
    
46.       (Repeat (1- rl)                        ;逐点分析.
    
47.         (setq al (Nth pn wpl)                ;取出点数据表.
    
48.               pt (Car al)                ;取出点位.
    
49.         )                                ;end_setq
    
50.         (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是断.
    
51.           (Progn (setq gx (Cadr al)        ;取出弓比.
    
52.                        bj (* (ATAN (ABS gx)) 4) ;计算包角.
    
53.                        np (Car (Nth (1+ pn) wpl)) ;取出下一点位.
    
54.                        xc (* 0.5 (Distance pt np)) ;半弦长计算.
    
55.                        gg (* gx xc)        ;弓高计算.
    
56.                        rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
    
57.                  )                        ;end_setq  
    
58.                  (setq cp (Polar pt (setq pa (Angle pt np)) xc)
    
59.                        cp (Polar cp (+ pa (* 0.5 PI)) (- rr gg))
    
60.                  )                        ;end_setq
    
61.           )                                ;end_progn
    
62.         )                                ;end_if
    
63.         (setq pn (1+ pn))
    
64.       )                                        ;end_repeat
    
65.       (setq retList wpll)
    
66.     )                                        ;end_progn
    
67.   )                                        ;end_if
    
68. )

(Defun ayGetPolyLineVTX        (LwPolyEntName /      entData1            entName1<br />                          pel        ptp    wpl    wpll   plp    par<br />                          ct        pen    rl     pn     clk    pt<br />                          al        gx     bj     np     xc            gg<br />                          rr        cp     retList<br />                         )<br />   (setq entName1 LwPolyEntName)<br />   (setq retList nil)<br />   (setq entData1 (entget entName1))<br />   (if (= "POLYLINE" (Cdr (Assoc 0 entData1)))<br />     (progn<br />       (setq pel             entData1                ;取出对象表.<br />             ptp             (Cdr (Assoc 70 pel)) ;取出结束片段型.<br />             wpl             '()                ;自建的点位数表.<br />             wpll     '()<br />             entName1 (EntNext entName1)<br />             pen             entName1<br />       )                                        ;end_setq<br />       (While (/= "SEQEND" (Cdr (Assoc 0 (entget pen)))) ;如果没束.<br />         (setq pel  (entget pen)                ;取得顶点对象数据表.<br />               plp  (Cdr (Assoc 10 pel))        ;取出控制点点位.<br />               par  (Cdr (Assoc 42 pel))        ;取出弓弦比.<br />               wpl  (Cons (List plp par) wpl) ;将数据加到WPL表中.<br />               wpll (cons plp wpll)<br />         )                                ;end_setq <br />         (setq pen (EntNext pen))        ;搜索下一个对象.<br />       )                                        ;end_while<br />       (setq wpll (Reverse wpll))<br />                                         ;以下代码暂时没有用！<br />       (setq ct (If (= 0 (Cadr (Car wpl)))<br />                  "直线片段封闭"<br />                  "弧片段封闭"<br />                )<br />       )<br />       (setq wpl        (Cons (Last wpl) wpl)        ;加入封闭点.<br />             wpl        (Reverse wpl)                ;整理WPL表.<br />             rl        (Length wpl)<br />             pn        0<br />       )                                        ;end_setq <br />       (setq clk        (If (Or (= 0 ptp) (= 128 ptp))<br />                   "开口"<br />                   "封闭"<br />                 )<br />       )<br />       (Repeat (1- rl)                        ;逐点分析.<br />         (setq al (Nth pn wpl)                ;取出点数据表.<br />               pt (Car al)                ;取出点位.<br />         )                                ;end_setq <br />         (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是断.<br />           (Progn (setq gx (Cadr al)        ;取出弓比.<br />                        bj (* (ATAN (ABS gx)) 4) ;计算包角.<br />                        np (Car (Nth (1+ pn) wpl)) ;取出下一点位.<br />                        xc (* 0.5 (Distance pt np)) ;半弦长计算.<br />                        gg (* gx xc)        ;弓高计算.<br />                        rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))<br />                  )                        ;end_setq  <br />                  (setq cp (Polar pt (setq pa (Angle pt np)) xc)<br />                        cp (Polar cp (+ pa (* 0.5 PI)) (- rr gg))<br />                  )                        ;end_setq <br />           )                                ;end_progn <br />         )                                ;end_if<br />         (setq pn (1+ pn))<br />       )                                        ;end_repeat<br />       (setq retList wpll)<br />     )                                        ;end_progn<br />   )                                        ;end_if<br /> )

知行ooo李肖坪

不错的东西，谢谢