[分享]：求两曲线交点函数

mkhsj927

[php]
(defun test(/ m_ent1 m_ent2 m_jdtab)
  (setq m_ent1 (car (entsel "\n请选择第一条曲线: ")))
  (setq m_ent2 (car (entsel "\n请选择第二条曲线: ")))
  (setq m_jdtab (m_IntersectWith m_ent1 m_ent2))
  (princ"\n交点表: ")(princ m_jdtab)
  (princ)
)

(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)
)
[/php]
希望高手提提意见！

cqnj023

(m_princ "\nObjectName：" m_objname)干什么用，好象没有定义

mkhsj927

最初由 cqnj023 发布
[B](m_princ "\nObjectName：" m_objname)干什么用，好象没有定义 [/B]

呵呵，测试时用的，搞忘删了

oyxx_1023

太感谢了。刚好需要。

qianxin723

真的不知道是怎么用的！能不能告诉要怎么才可以用？谢谢

winabcd

有没有纯LISP的程序？

Job_ho

可直接使用(vla-intersectwith object1 object2 extendoption)

梦断江南

是的,不用分那么细.只要是曲线,都可以用intersectwith方法得出交点后将数组交点表分成3个元素一组.
如果2纬相交,3纬不相交的情况,先设置undo开始标志,后将3纬线压平(用move的bug方法-0,0,1e99->0,0,-1e99),求交,设置结束标志undo 1 次

urljit

(vla-intersectwith object1 object2 extendoption) 和(vlax-curve-getClosestPointToProjection curve-obj givenPnt normal [extend]) 都可以取得交点?有什么区别呢?实在是看不懂后者的cad英文帮助

fools

(vlax-curve-getClosestPointToProjection curve-obj givenPnt normal [extend]) 的中文帮助

xyp1964

找不到(vla-intersectwith object1 object2 extendoption) 的使用帮助。
楼上能否提供一个完整的帮助文件，多谢！

urljit

谢谢fools，我也找到了中文的帮助。

1. 在将曲线投影到平面上之后，返回曲线上的最近点（在 WCS 上）
   
2. (vlax-curve-getClosestPointToProjection curve-obj  givenPnt normal [extend])
   
3. 
   
4. 参数
   
5. 
   
6. curve-obj
   
7. 
   
8. 要测量的 VLA 对象。
   
9. 
   
10. givenPnt
    
11. 
    
12. WCS 中的点，在曲线上寻找该点的最近点。
    
13. 
    
14. normal
    
15. 
    
16. WCS 中的法线矢量，指定投影平面。
    
17. 
    
18. extend
    
19. 
    
20. 如果指定该参数且其值不为 nil，vlax-curve-getClosestPointToProjection 在搜索最近点时扩展曲线。
    
21. 
    
22. vlax-curve-getClosestPointToProjection 将曲线投影到由 givenPnt 和 normal 定义的平面上，然后在该平面上计算距 givenPnt 最近的点。然后，
    
23. vlax-curve-getClosestPointToProjection 将结果点重新投影到原来的曲线上，并返回投影后的点。
    
24. 
    
25. 返回值
    
26. 
    
27. 如果成功，则返回表示曲线上一点的三维点表，否则返回 nil。

复制代码

XYP1964:我也没有发现哪里有电子版的帮助，我这里有一本书，是铁道出版社的，《autocad lisp/vlisp函数库查询辞典》，这倒是有函数的说明。

fools

(vla-intersectwith object1 object2 extendoption)
要查vba的method：
不光可用在曲线上，根据帮助除了Pviewport and PolygonMesh，其他实体均可

[PHP]
Gets the points where one object intersects another object in the drawing.

See Also | Example

Signature

RetVal = object.IntersectWith(IntersectObject, ExtendOption)

Object

All Drawing Objects (Except Pviewport and PolygonMesh)
The object or objects this method applies to.

IntersectObject

Object, input-only;
The object can be one of All Drawing Objects.


ExtendOption

AcExtendOption enum; input-only
This option specifies if none, one or both, of the objects are to be extended in order to attempt an intersection.

acExtendNone
Does not extend either object.

acExtendThisEntity
Extends the base object.

acExtendOtherEntity
Extends the object passed as an argument.

acExtendBoth
Extends both objects.


RetVal

Variant (array of doubles)
The array of points where one object intersects another object in the drawing.

Remarks

If the two objects do not intersect, no data is returned. You can request the point of intersection that would occur if one or both of the objects were extended to meet the other. For example, in the following illustration, Line1 is the base object from which this method was called and line3 is the object passed as a parameter. If the ExtendOption passed is acExtendThisEntity, point A is returned as the point where line1 would intersect line3 if line1 were extended. If the ExtendOption is acExtendOtherEntity, no data is returned because even if line3 were extended, it would not intersect line1.

If the intersection type is acExtendBothEntities and line2 is passed as the parameter entity, point B is returned. If the ExtendOption is acExtendNone and line2 is the parameter entity, no data is returned.


[/PHP]

xyp1964

谢谢urljit ：也有这本书。
哪儿有vla的函数帮助CHM版？现有的连“vla-erase”函数都找不到。

fools

我是在《ActiveX and VBA Reference》里查着用，好辛苦，渴望专门的vla的函数帮助CHM版