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