求多段线交点的思路

yanshengjiang

llsheng_73 发表于 2016-7-30 17:40
用ssget"F"以a的顶点表对等高线进行选择
通过ssnamex得到等高线与a的交点
函数名：tt

没看懂啊 大哥

我改了论坛求交点的程序，但是也还是有bug  会多或者漏点。

2. (vl-load-com)
   
3. (defun C:88 (/ m_entab m_vlaobj m_wlbpt m_wrupt  m_ss m_vlaobjcopy m_vlaobjcopy1
   
4.         m_ent *m_jdtab m_jdtab1 m_len i j)
   
5.   (command"ucs" "w")(command);;一定要在世界坐标系下
   
6.   (princ"\n纵断面与等高线交点插入高程点！")
   
7.   (setq m_entab (car (entsel "\n请选择一条线:")))
   
8.   
   
9.   (setq m_vlaobj (vlax-ename->vla-object m_entab))
   
10.   (vla-getboundingbox m_vlaobj 'm_wlbpt 'm_wrupt)
    
11.   (setq m_wlbpt (vlax-safearray->list m_wlbpt))  ;;窗口左下角点
    
12.   (setq m_wrupt (vlax-safearray->list m_wrupt))  ;;窗口右上角点
    
13.   (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point m_wlbpt)(vlax-3d-point m_wrupt));;缩放以使剖切线充满屏幕
    
14. 
    
15.   (setq m_ss (ssget "c" m_wlbpt m_wrupt '((0 . "*POLYLINE")(8 . "DGX"))))
    
16.   
    
17. ;;;  (setq m_ss (ssdel m_entab m_ss))
    
18.   (if m_ss
    
19.     (progn
    
20.       (setq m_vlaobjcopy (m_shadowtoxy (vla-copy m_vlaobj)));;复制剖切线实体并求投影至XY平面的实体
    
21.       (setq m_jdtab '())
    
22.       (setq i 0)
    
23.       (repeat (sslength m_ss)
    
24. (setq m_ent (ssname m_ss i));;取出选择集中的一个实体
    
25. (setq m_vlaobjcopy1
    
26.         (m_shadowtoxy
    
27.    (vla-copy (vlax-ename->vla-object m_ent))
    
28.         )
    
29. );;复制并求投影实体
    
30. 
    
31. (setq m_jdtab1 (vla-intersectwith
    
32.     m_vlaobjcopy
    
33.     m_vlaobjcopy1
    
34.     acExtendnone
    
35.   )
    
36. );;求剖切线与曲线实体的交点表
    
37. (if (> (vlax-safearray-get-u-bound (vlax-variant-value m_jdtab1) 1) 1) ;;判断有无交点
    
38.    
    
39.    (progn
    
40.      (setq m_jdtab1 (vlax-safearray->list (vlax-variant-value m_jdtab1)));;safearray数组转换为list表
    
41.      (setq j 0)
    
42. ;;;     (princ m_jdtab1)
    
43.      (repeat (/ (length m_jdtab1) 3)
    
44.        (setq m_jd (list (nth j m_jdtab1)
    
45.           (nth (+ 1 j) m_jdtab1)
    
46.           (nth (+ 2 j) m_jdtab1)
    
47.    )
    
48.        );;取得交点在投影的剖切线上
    
49.    
    
50.        (setq m_len (distance m_jd (vlax-curve-getstartpoint m_vlaobjcopy)));;交点到线起点得长度
    
51.       
    
52.        (setq m_jd (vlax-curve-getClosestPointToProjection
    
53.       (vlax-ename->vla-object m_ent)
    
54.       (list (car m_jd) (cadr m_jd) 0.0)
    
55.       '(0 0 1)
    
56.     )
    
57.        );;取得交点在实际的等高线上（主要是得到高程）
    
58. 
    
59.        (setq m_jdtab (cons (list m_len m_jd) m_jdtab));;构造交点表
    
60.        (setq j (+ 3 j))
    
61.      )
    
62.    )
    
63. )
    
64. (vla-delete m_vlaobjcopy1) ;;删除复制的曲线实体
    
65. (setq i (1+ i))
    
66.       )
    
67.       
    
68.       (vla-delete m_vlaobjcopy);;删除复制的线实体
    
69.       
    
70.       (setq m_jdtab (vl-sort m_jdtab '(lambda (a b) (< (car a) (car b))))) ;;对距离从小到大排序
    
71.     )
    
72.     (princ"\n没有选择到符合要求的线！")
    
73.   )
    
74. ;;;  m_jdtab  ;((0.872522 (3.45137e+07 3.49438e+06 999.0)) (0.87277 (3.45137e+07 3.49438e+06 999.0)))
    
75.   (setq j -1)
    
76. (while(setq a (car m_jdtab))
    
77.   (if(>(abs(- j (car a)))0.1)
    
78.     (entmake_gcd_yan (list(car(cadr a))(cadr(cadr a))) (last (cadr a)) 0.1 2))
    
79.   (setq j (car a))
    
80.   (setq m_jdtab(cdr m_jdtab))
    
81.   )
    
82.   (princ"\n纵断面与等高线交点插入高程点完成！")
    
83.   (PRIN1)
    
84. )
    
85. 
    
86. (defun m_shadowtoxy (m_obj / m_obj1 m_objname m_pts m_pts1 i)
    
87.   ;;对曲线实体m_obj创建一个投影至xy平面的曲线实体，即对曲线实体上每个控制点的z坐标置为0
    
88.   ;;返回实体名m_obj1
    
89.   (setq m_objname (vla-get-objectname m_obj))
    
90.   ;;取得实体的类型名称
    
91.   (cond
    
92.     ((= "AcDbSpline" m_objname)
    
93.      ;;样条曲线(Spline)
    
94.      (setq i 0)
    
95.      (setq m_pts (vlax-variant-value (vla-get-fitpoints m_obj)))
    
96.      ;;取得样条曲线的拟合点
    
97.      (setq m_pts1 (vlax-variant-value (vla-get-controlpoints m_obj)))
    
98.      ;;取得样条曲线的控制点
    
99.      (repeat (vla-get-numberoffitpoints m_obj)
    
100.        (vlax-safearray-put-element m_pts (+ i 2) 0.0)
     
101.        ;;改变每个拟合点的z值为0.0
     
102.        (setq i (+ i 3))
     
103.      )
     
104.      (vla-put-fitpoints m_obj m_pts)
     
105.      ;;更改曲线拟合点属性
     
106. 
     
107.      (setq i 0)
     
108. 
     
109.      (repeat (vla-get-numberofcontrolpoints m_obj)
     
110.        ;;循环
     
111.        (vlax-safearray-put-element m_pts1 (+ i 2) 0.0)
     
112.        ;;改变每个控制点的z值为0.0
     
113.        (setq i (+ i 3))
     
114.      )
     
115.      (vla-put-controlpoints m_obj m_pts1)
     
116.      ;;更改曲线控制点属性
     
117.     )
     
118. 
     
119.     ((= "AcDb3dPolyline" m_objname)
     
120.      ;;三维多段线(3dpolyline)
     
121.      (setq i 0)
     
122.      (setq m_pts (vlax-variant-value (vla-get-coordinates m_obj)))
     
123.      ;;取得3维多段线的控制点
     
124.      (repeat (/ (length (vlax-safearray->list m_pts)) 3)
     
125.        (vlax-safearray-put-element m_pts (+ i 2) 0.0)
     
126.        (setq i (+ i 3))
     
127.      )
     
128.      (vla-put-coordinates m_obj m_pts)
     
129.     )
     
130. 
     
131.     ((= "AcDbLine" m_objname)
     
132.      ;;直线(line)
     
133.      (setq i 0)
     
134.      (setq m_pts (vlax-variant-value (vla-get-startpoint m_obj)))
     
135.      ;;取得直线的起点座标
     
136.      (setq m_pts1 (vlax-variant-value (vla-get-endpoint m_obj)))
     
137.      ;;取得直线的终点座标
     
138.      (vlax-safearray-put-element m_pts 2 0.0)
     
139.      ;;改变起点座标z值为0.0
     
140.      (vlax-safearray-put-element m_pts1 2 0.0)
     
141.      ;;改变终点座标z值为0.0
     
142.      (vla-put-startpoint m_obj m_pts)
     
143.      (vla-put-endpoint m_obj m_pts1)
     
144.     )
     
145. 
     
146.     ((or (= "AcDbCircle" m_objname)
     
147.   ;;园(circle)
     
148.   (= "AcDbArc" m_objname)
     
149.   ;;圆弧(arc)
     
150.   (= "AcDbEllipse" m_objname)
     
151.   ;;椭圆及椭圆弧(ellipse)
     
152.      )
     
153.      (setq m_pts (vlax-variant-value (vla-get-center m_obj)))
     
154.      (vlax-safearray-put-element m_pts 2 0.0)
     
155.      ;;改变中心点座标z值为0.0
     
156.      (vla-put-center m_obj m_pts)
     
157.     )
     
158. 
     
159.     ((or (= "AcDbPolyline" m_objname)
     
160.   ;;多段线(polyline、lwpolyline)
     
161.   (= "AcDb2dPolyline" m_objname)
     
162.   ;;拟合的2维多段线(polyline、lwpolyline)
     
163.      )
     
164.      (vla-put-elevation m_obj 0.0)
     
165.      ;;改变标高值为0.0
     
166.     )
     
167.   )
     
168.   (setq m_obj1 m_obj)
     
169. )
     
170. 
     
171. 
     
172. 
     

(vl-load-com)<br /> (defun C:88 (/ m_entab m_vlaobj m_wlbpt m_wrupt  m_ss m_vlaobjcopy m_vlaobjcopy1<br />         m_ent *m_jdtab m_jdtab1 m_len i j)<br />   (command"ucs" "w")(command);;一定要在世界坐标系下<br />   (princ"\n纵断面与等高线交点插入高程点！")<br />   (setq m_entab (car (entsel "\n请选择一条线:")))<br />   <br />   (setq m_vlaobj (vlax-ename->vla-object m_entab))<br />   (vla-getboundingbox m_vlaobj 'm_wlbpt 'm_wrupt)<br />   (setq m_wlbpt (vlax-safearray->list m_wlbpt))  ;;窗口左下角点<br />   (setq m_wrupt (vlax-safearray->list m_wrupt))  ;;窗口右上角点<br />   (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point m_wlbpt)(vlax-3d-point m_wrupt));;缩放以使剖切线充满屏幕<br /> <br />   (setq m_ss (ssget "c" m_wlbpt m_wrupt '((0 . "*POLYLINE")(8 . "DGX"))))<br />   <br /> ;;;  (setq m_ss (ssdel m_entab m_ss))<br />   (if m_ss<br />     (progn<br />       (setq m_vlaobjcopy (m_shadowtoxy (vla-copy m_vlaobj)));;复制剖切线实体并求投影至XY平面的实体<br />       (setq m_jdtab '())<br />       (setq i 0)<br />       (repeat (sslength m_ss)<br /> (setq m_ent (ssname m_ss i));;取出选择集中的一个实体<br /> (setq m_vlaobjcopy1<br />         (m_shadowtoxy<br />    (vla-copy (vlax-ename->vla-object m_ent))<br />         )<br /> );;复制并求投影实体<br /> <br /> (setq m_jdtab1 (vla-intersectwith<br />     m_vlaobjcopy<br />     m_vlaobjcopy1<br />     acExtendnone<br />   )<br /> );;求剖切线与曲线实体的交点表<br /> (if (> (vlax-safearray-get-u-bound (vlax-variant-value m_jdtab1) 1) 1) ;;判断有无交点<br />    <br />    (progn<br />      (setq m_jdtab1 (vlax-safearray->list (vlax-variant-value m_jdtab1)));;safearray数组转换为list表<br />      (setq j 0)<br /> ;;;     (princ m_jdtab1)<br />      (repeat (/ (length m_jdtab1) 3)<br />        (setq m_jd (list (nth j m_jdtab1)<br />           (nth (+ 1 j) m_jdtab1)<br />           (nth (+ 2 j) m_jdtab1)<br />    )<br />        );;取得交点在投影的剖切线上<br />    <br />        (setq m_len (distance m_jd (vlax-curve-getstartpoint m_vlaobjcopy)));;交点到线起点得长度<br />        <br />        (setq m_jd (vlax-curve-getClosestPointToProjection<br />       (vlax-ename->vla-object m_ent)<br />       (list (car m_jd) (cadr m_jd) 0.0)<br />       '(0 0 1)<br />     )<br />        );;取得交点在实际的等高线上（主要是得到高程）<br /> <br />        (setq m_jdtab (cons (list m_len m_jd) m_jdtab));;构造交点表<br />        (setq j (+ 3 j))<br />      )<br />    )<br /> )<br /> (vla-delete m_vlaobjcopy1) ;;删除复制的曲线实体<br /> (setq i (1+ i))<br />       )<br />       <br />       (vla-delete m_vlaobjcopy);;删除复制的线实体<br />       <br />       (setq m_jdtab (vl-sort m_jdtab '(lambda (a b) (< (car a) (car b))))) ;;对距离从小到大排序<br />     )<br />     (princ"\n没有选择到符合要求的线！")<br />   )<br /> ;;;  m_jdtab  ;((0.872522 (3.45137e+07 3.49438e+06 999.0)) (0.87277 (3.45137e+07 3.49438e+06 999.0)))<br />   (setq j -1)<br /> (while(setq a (car m_jdtab))<br />   (if(>(abs(- j (car a)))0.1)<br />     (entmake_gcd_yan (list(car(cadr a))(cadr(cadr a))) (last (cadr a)) 0.1 2))<br />   (setq j (car a))<br />   (setq m_jdtab(cdr m_jdtab))<br />   )<br />   (princ"\n纵断面与等高线交点插入高程点完成！")<br />   (PRIN1)<br /> )<br /> <br /> (defun m_shadowtoxy (m_obj / m_obj1 m_objname m_pts m_pts1 i)<br />   ;;对曲线实体m_obj创建一个投影至xy平面的曲线实体，即对曲线实体上每个控制点的z坐标置为0<br />   ;;返回实体名m_obj1<br />   (setq m_objname (vla-get-objectname m_obj))<br />   ;;取得实体的类型名称<br />   (cond<br />     ((= "AcDbSpline" m_objname)<br />      ;;样条曲线(Spline)<br />      (setq i 0)<br />      (setq m_pts (vlax-variant-value (vla-get-fitpoints m_obj)))<br />      ;;取得样条曲线的拟合点<br />      (setq m_pts1 (vlax-variant-value (vla-get-controlpoints m_obj)))<br />      ;;取得样条曲线的控制点<br />      (repeat (vla-get-numberoffitpoints m_obj)<br />        (vlax-safearray-put-element m_pts (+ i 2) 0.0)<br />        ;;改变每个拟合点的z值为0.0<br />        (setq i (+ i 3))<br />      )<br />      (vla-put-fitpoints m_obj m_pts)<br />      ;;更改曲线拟合点属性<br /> <br />      (setq i 0)<br /> <br />      (repeat (vla-get-numberofcontrolpoints m_obj)<br />        ;;循环<br />        (vlax-safearray-put-element m_pts1 (+ i 2) 0.0)<br />        ;;改变每个控制点的z值为0.0<br />        (setq i (+ i 3))<br />      )<br />      (vla-put-controlpoints m_obj m_pts1)<br />      ;;更改曲线控制点属性<br />     )<br /> <br />     ((= "AcDb3dPolyline" m_objname)<br />      ;;三维多段线(3dpolyline)<br />      (setq i 0)<br />      (setq m_pts (vlax-variant-value (vla-get-coordinates m_obj)))<br />      ;;取得3维多段线的控制点<br />      (repeat (/ (length (vlax-safearray->list m_pts)) 3)<br />        (vlax-safearray-put-element m_pts (+ i 2) 0.0)<br />        (setq i (+ i 3))<br />      )<br />      (vla-put-coordinates m_obj m_pts)<br />     )<br /> <br />     ((= "AcDbLine" m_objname)<br />      ;;直线(line)<br />      (setq i 0)<br />      (setq m_pts (vlax-variant-value (vla-get-startpoint m_obj)))<br />      ;;取得直线的起点座标<br />      (setq m_pts1 (vlax-variant-value (vla-get-endpoint m_obj)))<br />      ;;取得直线的终点座标<br />      (vlax-safearray-put-element m_pts 2 0.0)<br />      ;;改变起点座标z值为0.0<br />      (vlax-safearray-put-element m_pts1 2 0.0)<br />      ;;改变终点座标z值为0.0<br />      (vla-put-startpoint m_obj m_pts)<br />      (vla-put-endpoint m_obj m_pts1)<br />     )<br /> <br />     ((or (= "AcDbCircle" m_objname)<br />   ;;园(circle)<br />   (= "AcDbArc" m_objname)<br />   ;;圆弧(arc)<br />   (= "AcDbEllipse" m_objname)<br />   ;;椭圆及椭圆弧(ellipse)<br />      )<br />      (setq m_pts (vlax-variant-value (vla-get-center m_obj)))<br />      (vlax-safearray-put-element m_pts 2 0.0)<br />      ;;改变中心点座标z值为0.0<br />      (vla-put-center m_obj m_pts)<br />     )<br /> <br />     ((or (= "AcDbPolyline" m_objname)<br />   ;;多段线(polyline、lwpolyline)<br />   (= "AcDb2dPolyline" m_objname)<br />   ;;拟合的2维多段线(polyline、lwpolyline)<br />      )<br />      (vla-put-elevation m_obj 0.0)<br />      ;;改变标高值为0.0<br />     )<br />   )<br />   (setq m_obj1 m_obj)<br /> )<br /> <br /> <br /> <br />