[LISP函数]：计算直线与曲线交点

qyang2001

:5
如何用Lisp程序计算支线Line与曲线（二次样条或PLINE拟合曲线）三交点，请诸位高手提供帮助！

XDSoft

最初由 qyang2001 发布
[B]:5
如何用Lisp程序计算支线Line与曲线（二次样条或PLINE拟合曲线）三交点，请诸位高手提供帮助！ [/B]

推荐你使用XDRX_API

2. [font=courier new]
   
3. 86. xdrx_getinters
   
4. 
   
5. 功能：1.求两个AcDbCurve(曲线)实体的交点.
   
6.       2.求一个AcDbCurve(曲线)实体和一个选择集中所有AcDbCurve(曲线)的交点。
   
7.       3.求一个选择集中所有AcDbCurve(曲线)实体的交点.
   
8.       4.求一个选择集SS1中的所有AcDbCurve实体和另个选择集SS2所有AcDbCurve实体的交点。
   
9.       
   
10. 调用格式： 1. (xdrx_getinters <实体图元1> <实体图元2> [扩展方式])
    
11.           2. (xdrx_getinters <实体图元名> <选择集> [扩展方式])
    
12.           2. (xdrx_getinters <选择集> [扩展方式])
    
13.           3. (xdrx_getinters <选择集1> <选择集2> [扩展方式])
    
14.           4. (xdrx_getinters (<pt1>...<ptn>) <曲线实体名> [扩展方式])
    
15.           5. (xdrx_getinters (<pt1>...<ptn>) <选择集> [扩展方式])
    
16.           6. (xdrx_getinters (<pt1>...<ptn>) (<pt1>...<ptn>) [扩展方式])
    
17. 
    
18. 说明：1.程序能求AcDbCurve(包括：AcDbLine、AcDbArc、AcDbCircle、AcDbEllipse、AcDbSpline、
    
19.        AcDbPolyline(lwpolyline)交点。
    
20.      2.参数[扩展方式]：
    
21.        对于1种情况：
    
22.          0：不延伸实体
    
23.          1：延伸第一个实体
    
24.          2：延伸第二个实体
    
25.          3: 两个都延伸
    
26.        对于第二、三、四种情况(选择集):
    
27.          0: 不延伸实体
    
28.          1: 两个都延伸
    
29. 
    
30. 示例： 1. 求天正建筑软件轴线层上，所有轴线的交点
    
31.       (if (setq ss (ssget "x" (list (cons 8 (xdrx_getlyrname "轴线")) '((0 . "line")))))
    
32.          (progn
    
33.              (setq intl (xdrx_getinters ss))
    
34.          )
    
35.       )
    
36.       
    
37.       2. 点取一根轴线，然后求出与这个轴线相交的所有轴线交点。
    
38.       (setq lyr (xdrx_getlyrname "轴线"))
    
39.       (if (setq en (xdrx_entsel "\n请点取一个轴线<退出>:" (list (cons 8 lyr) '(0 . "line"))))
    
40.          (progn
    
41.             (xdrx_setentodb)
    
42.             (setq p1 (xdrx_getentdxf 10)
    
43.                   p2 (xdrx_getentdxf 11)
    
44.                   ss (ssget "f" p1 p2 (list (cons 8 lyr) '(0 . "line")))
    
45.             )
    
46.             (if (setq intl (xdrx_getinters (car en) ss))
    
47.                (progn
    
48.                   .....;;intl中为交点表
    
49.                )
    
50.             )
    
51.          )
    
52.       )         
    
53. 
    
54. [/font]

[font=courier new]<br /> 86. xdrx_getinters<br /> <br /> 功能：1.求两个AcDbCurve(曲线)实体的交点.<br />       2.求一个AcDbCurve(曲线)实体和一个选择集中所有AcDbCurve(曲线)的交点。<br />       3.求一个选择集中所有AcDbCurve(曲线)实体的交点.<br />       4.求一个选择集SS1中的所有AcDbCurve实体和另个选择集SS2所有AcDbCurve实体的交点。<br />       <br /> 调用格式： 1. (xdrx_getinters <实体图元1> <实体图元2> [扩展方式])<br />           2. (xdrx_getinters <实体图元名> <选择集> [扩展方式])<br />           2. (xdrx_getinters <选择集> [扩展方式])<br />           3. (xdrx_getinters <选择集1> <选择集2> [扩展方式])<br />           4. (xdrx_getinters (<pt1>...<ptn>) <曲线实体名> [扩展方式])<br />           5. (xdrx_getinters (<pt1>...<ptn>) <选择集> [扩展方式])<br />           6. (xdrx_getinters (<pt1>...<ptn>) (<pt1>...<ptn>) [扩展方式])<br /> <br /> 说明：1.程序能求AcDbCurve(包括：AcDbLine、AcDbArc、AcDbCircle、AcDbEllipse、AcDbSpline、<br />        AcDbPolyline(lwpolyline)交点。<br />      2.参数[扩展方式]：<br />        对于1种情况：<br />          0：不延伸实体<br />          1：延伸第一个实体<br />          2：延伸第二个实体<br />          3: 两个都延伸<br />        对于第二、三、四种情况(选择集):<br />          0: 不延伸实体<br />          1: 两个都延伸<br /> <br /> 示例： 1. 求天正建筑软件轴线层上，所有轴线的交点<br />       (if (setq ss (ssget "x" (list (cons 8 (xdrx_getlyrname "轴线")) '((0 . "line")))))<br />          (progn<br />              (setq intl (xdrx_getinters ss))<br />          )<br />       )<br />       <br />       2. 点取一根轴线，然后求出与这个轴线相交的所有轴线交点。<br />       (setq lyr (xdrx_getlyrname "轴线"))<br />       (if (setq en (xdrx_entsel "\n请点取一个轴线<退出>:" (list (cons 8 lyr) '(0 . "line"))))<br />          (progn<br />             (xdrx_setentodb)<br />             (setq p1 (xdrx_getentdxf 10)<br />                   p2 (xdrx_getentdxf 11)<br />                   ss (ssget "f" p1 p2 (list (cons 8 lyr) '(0 . "line")))<br />             )<br />             (if (setq intl (xdrx_getinters (car en) ss))<br />                (progn<br />                   .....;;intl中为交点表<br />                )<br />             )<br />          )<br />       )          <br /> <br /> [/font]

cy956

vlax方法也很方便。

LUCAS

2. 
   
3. (defun TEST (PL1 PL2 / IPTS PTS)
   
4.   (setq        IPTS (vla-intersectwith
   
5.                (vlax-ename->vla-object PL1)
   
6.                (vlax-ename->vla-object PL2)
   
7.                acExtendNone ;Does not extend either object
   
8.              )
   
9.         IPTS (vlax-variant-value IPTS)
   
10.   )
    
11.   (if (> (vlax-safearray-get-u-bound IPTS 1) 0)
    
12.     (progn (setq IPTS
    
13.                   (vlax-safearray->list IPTS)
    
14.            )
    
15.            (while (> (length IPTS) 0)
    
16.              (setq PTS        (cons (list (car IPTS)
    
17.                                     (cadr IPTS)
    
18.                                     (caddr IPTS)
    
19.                               )
    
20.                               PTS
    
21.                         )
    
22.                    IPTS        (cdddr IPTS)
    
23.              )
    
24.            )
    
25.     )
    
26.   )
    
27.   PTS
    
28. )
    
29. 
    
30. ;;USAGE: (TEST (car (entsel)) (car (entsel)))
    

<br /> (defun TEST (PL1 PL2 / IPTS PTS)<br />   (setq        IPTS (vla-intersectwith<br />                (vlax-ename->vla-object PL1)<br />                (vlax-ename->vla-object PL2)<br />                acExtendNone ;Does not extend either object<br />              )<br />         IPTS (vlax-variant-value IPTS)<br />   )<br />   (if (> (vlax-safearray-get-u-bound IPTS 1) 0)<br />     (progn (setq IPTS<br />                   (vlax-safearray->list IPTS)<br />            )<br />            (while (> (length IPTS) 0)<br />              (setq PTS        (cons (list (car IPTS)<br />                                     (cadr IPTS)<br />                                     (caddr IPTS)<br />                               )<br />                               PTS<br />                         )<br />                    IPTS        (cdddr IPTS)<br />              )<br />            )<br />     )<br />   )<br />   PTS<br /> )<br /> <br /> ;;USAGE: (TEST (car (entsel)) (car (entsel)))<br />