根据大于3点的三维多段线首尾高程分配给中间个点

树櫴希德

根据大于3点的三维多段线首尾高程分配给中间个点

1. ;; 测量选定曲线上两点之间的距离
   
2. (defun apkl (ENOBJ p1 p2 / DIST DIST1 DIST2 EN ENOBJ OSM P1 P2)
   
3. ;;;来源：QQ群友：GreenWood(181976640)。属QQ群：SP编程,e派<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>箱,摄影  24942984
   
4.   
   
5.   
   
6. ;(setq ENOBJ (CAR (ENTSEL)))
   
7. ;(setq p1 (getpoint "\n选择曲线上的一点："))
   
8. ;(setq p2 (getpoint "\n选择曲线上的另一点："))
   
9. (setq dist1 (vlax-curve-getDistAtPoint enobj p1))
   
10. (setq dist2 (vlax-curve-getDistAtPoint enobj p2))
    
11. ;(print "\n测量段曲线长度：")
    
12. (setq dist (abs (- dist1 dist2)))
    
13. dist
    
14. )
    
15. 
    
16. (defun vxs (e / i v lst ppp)
    
17.   (setq i 0)
    
18.   (while
    
19.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    
20.      (setq lst (cons v lst))
    
21.   )
    
22.   (setq ppp (reverse lst) )
    
23. (append (list(vlax-curve-getpointatparam e 0)) ppp )
    
24.   
    
25.   )
    
26. ;;;;;;;;
    
27. (defun  ddx ( Polyline  p1  gccc / x xdb xh coord temp0 temp1  PolylineObj aaa n)
    
28.   
    
29. (setq PolylineObj (vlax-ename->vla-object Polyline ) )
    
30.   (setq aaa (vxs Polyline) )     (setq n (length aaa))
    
31.   (setq xdb (apply 'append (mapcar'(lambda(x)(setq aaa(cdr aaa))   (list(cons (- n (length aaa)) x))  )aaa))  )
    
32. 
    
33. 
    
34. (foreach x  xdb
    
35.    
    
36.       (if    (< (distance (list (nth 1 x) (nth 2 x) ) (list (car p1) (cadr p1)) )  0.0500)
    
37. 
    
38. (setq xh (-(car x) 1))
    
39.   ;(setq xh nil )
    
40. 
    
41.   )
    
42.    
    
43. 
    
44. );;;;;;
    
45. ;; 找出第一个索引位置的坐标
    
46. 
    
47.   (setq coord(vla-get-Coordinate PolylineObj  xh))
    
48. 
    
49. 
    
50. ;;; 改变坐标
    
51. 
    
52.   ;(setq temp(+ (vlax-safearray-get-element (vlax-variant-value coord) 0) 1))
    
53. (setq temp0 (car p1)
    
54.       temp1  (cadr p1)
    
55.            
    
56. 
    
57.      )
    
58. 
    
59.   (setq coord(vlax-variant-value coord))
    
60. 
    
61.   (vlax-safearray-put-element coord 0 temp0)
    
62. 
    
63. (vlax-safearray-put-element coord 1 temp1)
    
64. (vlax-safearray-put-element coord 2 gccc)
    
65.   (vla-put-Coordinate PolylineObj xh coord)
    
66. 
    
67.   (vla-Update PolylineObj)
    
68.   
    
69. ;;;;;;;
    
70.   )
    
71. 
    
72. 
    
73.       
    
74. 
    
75. ;;;;;;;
    
76. 
    
77. (defun c:bg (  / ENOBJ p1 p2 s1 s2 p3  dist gcc bz dist1 xgc y)
    
78. 
    
79. (setq ENOBJ (CAR (ENTSEL "\n请选择线段")))
    
80. (setq p1 (getpoint "\n选择曲线上的一点："))
    
81.   (setq s1 (getreal "\n请输入该点标高："))
    
82. (setq p2 (getpoint "\n选择曲线上的另一点："))
    
83. (setq s2 (getreal "\n请输入该点标高："))
    
84.   (setq dist (apkl ENOBJ p1 p2 ))
    
85. (setq gcc (- s1 s2))
    
86.   (setq bz (/ gcc dist))
    
87. 
    
88.   (foreach  y   (vl-remove  (last (cdr(vxs ENOBJ) ))  (cdr(vxs ENOBJ) ) )
    
89.         
    
90.         (setq dist1 (apkl ENOBJ y p2 ) )
    
91. (setq xgc (+ s2 (* dist1 bz )))
    
92.    (ddx ENOBJ  y  xgc )
    
93. (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos xgc 2 3)) (cons 10 y ) (cons 40 1.0)))
    
94.     )
    
95. 
    
96.   
    
97. (ddx ENOBJ  p1  s1 )
    
98.   (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s1 2 3)) (cons 10 p1 ) (cons 40 1.0)))
    
99.   (ddx ENOBJ  p2  s2 )
    
100.   (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s2 2 3)) (cons 10 p2 ) (cons 40 1.0)))
     
101. (princ)
     
102.       )

;; 测量选定曲线上两点之间的距离<br /> (defun apkl (ENOBJ p1 p2 / DIST DIST1 DIST2 EN ENOBJ OSM P1 P2)<br /> ;;;来源：QQ群友：GreenWood(181976640)。属QQ群：SP编程,e派<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink"><a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a></a>箱,摄影  24942984<br />   <br />   <br /> ;(setq ENOBJ (CAR (ENTSEL)))<br /> ;(setq p1 (getpoint "\n选择曲线上的一点："))<br /> ;(setq p2 (getpoint "\n选择曲线上的另一点："))<br /> (setq dist1 (vlax-curve-getDistAtPoint enobj p1))<br /> (setq dist2 (vlax-curve-getDistAtPoint enobj p2))<br /> ;(print "\n测量段曲线长度：")<br /> (setq dist (abs (- dist1 dist2)))<br /> dist<br /> )<br /> <br /> (defun vxs (e / i v lst ppp)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (setq ppp (reverse lst) )<br /> (append (list(vlax-curve-getpointatparam e 0)) ppp )<br />   <br />   )<br /> ;;;;;;;;<br /> (defun  ddx ( Polyline  p1  gccc / x xdb xh coord temp0 temp1  PolylineObj aaa n)<br />   <br /> (setq PolylineObj (vlax-ename->vla-object Polyline ) )<br />   (setq aaa (vxs Polyline) )     (setq n (length aaa))<br />   (setq xdb (apply 'append (mapcar'(lambda(x)(setq aaa(cdr aaa))   (list(cons (- n (length aaa)) x))  )aaa))  )<br /> <br /> <br /> (foreach x  xdb<br />     <br />       (if    (< (distance (list (nth 1 x) (nth 2 x) ) (list (car p1) (cadr p1)) )  0.0500)<br /> <br /> (setq xh (-(car x) 1))<br />   ;(setq xh nil )<br /> <br />   ) <br />     <br /> <br /> );;;;;;<br /> ;; 找出第一个索引位置的坐标<br /> <br />   (setq coord(vla-get-Coordinate PolylineObj  xh))<br /> <br /> <br /> ;;; 改变坐标<br /> <br />   ;(setq temp(+ (vlax-safearray-get-element (vlax-variant-value coord) 0) 1))<br /> (setq temp0 (car p1)<br />       temp1  (cadr p1)<br />            <br /> <br />      )<br /> <br />   (setq coord(vlax-variant-value coord))<br /> <br />   (vlax-safearray-put-element coord 0 temp0)<br /> <br /> (vlax-safearray-put-element coord 1 temp1)<br /> (vlax-safearray-put-element coord 2 gccc)<br />   (vla-put-Coordinate PolylineObj xh coord)<br /> <br />   (vla-Update PolylineObj)<br />   <br /> ;;;;;;;<br />   )<br /> <br /> <br />       <br /> <br /> ;;;;;;;<br /> <br /> (defun c:bg (  / ENOBJ p1 p2 s1 s2 p3  dist gcc bz dist1 xgc y)<br /> <br /> (setq ENOBJ (CAR (ENTSEL "\n请选择线段")))<br /> (setq p1 (getpoint "\n选择曲线上的一点："))<br />   (setq s1 (getreal "\n请输入该点标高："))<br /> (setq p2 (getpoint "\n选择曲线上的另一点："))<br /> (setq s2 (getreal "\n请输入该点标高："))<br />   (setq dist (apkl ENOBJ p1 p2 ))<br /> (setq gcc (- s1 s2))<br />   (setq bz (/ gcc dist))<br /> <br />   (foreach  y   (vl-remove  (last (cdr(vxs ENOBJ) ))  (cdr(vxs ENOBJ) ) )<br />         <br />         (setq dist1 (apkl ENOBJ y p2 ) )<br /> (setq xgc (+ s2 (* dist1 bz )))<br />    (ddx ENOBJ  y  xgc )<br /> (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos xgc 2 3)) (cons 10 y ) (cons 40 1.0)))<br />     )<br /> <br />   <br /> (ddx ENOBJ  p1  s1 )<br />   (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s1 2 3)) (cons 10 p1 ) (cons 40 1.0)))<br />   (ddx ENOBJ  p2  s2 )<br />   (entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s2 2 3)) (cons 10 p2 ) (cons 40 1.0)))<br /> (princ)<br />       )