(defun m_IntersectWith (m_ent1 m_ent2 / m_obj1 m_obj2 m_objcopy1 m_objcopy2 m_jdtab m_jdtab1 i) ;;适用对像: Line、Polyline、LWPolyline、Circle、Arc、Ellipse、3dPolyline、Spline ;;支持求空间虚交点,但Z坐标始终为0.0,要求Z坐标,请用(vlax-curve-getClosestPointToProjection)函数 (setq m_obj1 (vlax-ename->vla-object m_ent1)) (setq m_obj2 (vlax-ename->vla-object m_ent2)) (setq m_objcopy1 (vla-copy m_obj1));;复制第一条曲线实体 (setq m_objcopy2 (vla-copy m_obj2));;复制第二条曲线实体 (setq m_objcopy1 (m_ShadowToXY m_objcopy1));;得到投影实体 (setq m_objcopy2 (m_ShadowToXY m_objcopy2));;得到投影实体 (setq m_jdtab1 (vla-intersectwith m_objcopy1 m_objcopy2 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 i 0) (repeat (/ (length m_jdtab1) 3) (setq m_jd (list (nth i m_jdtab1) (nth (+ 1 i) m_jdtab1) (nth (+ 2 i) m_jdtab1)));;取得一个交点 (setq m_jdtab (cons m_jd m_jdtab));;构造交点表((第一个交点) (第二个交点)。。。) (setq i (+ 3 i)) ) ) (princ"\n两曲线无交点!") ) (vla-delete m_objcopy1);;删除复制的第一条曲线实体 (vla-delete m_objcopy2);;删除复制的第二条曲线实体 (setq m_jdtab m_jdtab);;返回交点表,无交点返回nil ) (defun m_ShadowToXY(m_obj / m_objname m_pts m_pts1 i) ;;对曲线实体m_obj创建一个投影至xy平面的曲线实体,即对曲线实体上每个控制点的z坐标值置为0.0 ;;输入曲线实体(vla对像) ;;返回投影实体(vla对像) (setq m_objname (vla-get-objectname m_obj));;取得实体的类型名称 ; (m_princ "\nObjectName:" m_objname) (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) (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_obj m_obj) ) (defun C:test (/ m_ent1 m_ent2 m_jdtab) ; (vl-load-com)
(setq m_ent1 (car (entsel "\n请选择第一条曲线: "))) (setq m_ent2 (car (entsel "\n请选择第二条曲线: "))) (setq ZL-GETINTERS (m_IntersectWith m_ent1 m_ent2)) (princ"\n交点表: ")(princ ZL-GETINTERS) (princ) ) ;Andyhon大侠 ;帮我看看,测试后也不返回交点列表呀,也不知道哪里出错
;AUTOCAD 2008 測試O.K |