检查曲线相切、圆弧相切。

chen3732088

1、圆弧相切是圆弧圆心距是否与半径差（内切）或半径和（外切）相等。默认两圆弧端点重合。
2、曲线相切是求曲线端点的切线向量，然后判断两端点的单位向量积是否为1或-1。适用于直线和曲线，可检测两端点是否重合。

llsheng_73

好象都有点问题，第一个是强行要求两个圆弧端点重合，不然不进行行判断
院长只计算圆心距与半径和(差)比较，没有管它们实际有无切点


无聊用院长的代码加上判断两ARC有无交点作为是否进一步计算的依据

1. (defun c:ACA(/ e1 e2 s1 s2 r1 r2 dd)
   
2.   (vl-load-com)
   
3.   (if (and (setq e1 (car (entsel "\n选择第一条弧<退出>: ")))
   
4.            (vl-position'(0 . "ARC")(setq s1(entget e1)))
   
5.            (setq e2 (car (entsel "\n选择第二条弧<退出>: ")))
   
6.            (vl-position'(0 . "ARC")(setq s2(entget e2)))
   
7.            (not(equal e1 e2))
   
8.            (>(vlax-safearray-get-u-bound(vlax-variant-value(vlax-invoke-method(vlax-ename->vla-object e1)'IntersectWith(vlax-ename->vla-object e2)0))1)0)
   
9.            (setq r1(cdr(assoc 40 s1))
   
10.                  r2(cdr(assoc 40 s2))
    
11.                  dd(distance(cdr(assoc 10 s1))(cdr(assoc 10 s2))))
    
12.            (vl-some'(lambda(x)(equal dd(eval x)1e-6))'((+ r1 r2)(abs(- r1 r2)))))
    
13.     (alert "两弧相切")
    
14.     (alert "两弧不相切"))
    
15. )

(defun c:ACA(/ e1 e2 s1 s2 r1 r2 dd)<br />   (vl-load-com)<br />   (if (and (setq e1 (car (entsel "\n选择第一条弧<退出>: ")))<br />            (vl-position'(0 . "ARC")(setq s1(entget e1)))<br />            (setq e2 (car (entsel "\n选择第二条弧<退出>: ")))<br />            (vl-position'(0 . "ARC")(setq s2(entget e2)))<br />            (not(equal e1 e2))<br />            (>(vlax-safearray-get-u-bound(vlax-variant-value(vlax-invoke-method(vlax-ename->vla-object e1)'IntersectWith(vlax-ename->vla-object e2)0))1)0)<br />            (setq r1(cdr(assoc 40 s1))<br />                  r2(cdr(assoc 40 s2))<br />                  dd(distance(cdr(assoc 10 s1))(cdr(assoc 10 s2))))<br />            (vl-some'(lambda(x)(equal dd(eval x)1e-6))'((+ r1 r2)(abs(- r1 r2)))))<br />     (alert "两弧相切")<br />     (alert "两弧不相切"))<br /> )

moranyuyan

谢谢分享

qazxswk

支持源码。

xyp1964

1. (defun c:ACA ()
   
2.   (defun DXF (code e) (cdr (assoc code (entget e))))
   
3.   (if (and (setq s1 (car (entsel "\n选择第一条弧<退出>: ")))
   
4.            (setq s2 (car (entsel "\n选择第二条弧<退出>: ")))
   
5.            (equal (DXF 0 s1) "ARC")
   
6.            (equal (DXF 0 s2) "ARC")
   
7.            (not (equal s1 s2))
   
8.       )
   
9.     (progn
   
10.       (setq r1  (DXF 40 s1)
    
11.             r2  (DXF 40 s2)
    
12.             c1  (DXF 10 s1)
    
13.             c2  (DXF 10 s2)
    
14.             sum (+ r1 r2)
    
15.             dr  (abs (- r1 r2))
    
16.             dd  (distance c1 c2)
    
17.       )
    
18.       (if (or (equal dd sum 1e-6) (equal dd dr 1e-6))
    
19.         (alert "两弧相切")
    
20.         (alert "两弧不相切")
    
21.       )
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

(defun c:ACA ()<br />   (defun DXF (code e) (cdr (assoc code (entget e))))<br />   (if (and (setq s1 (car (entsel "\n选择第一条弧<退出>: ")))<br />            (setq s2 (car (entsel "\n选择第二条弧<退出>: ")))<br />            (equal (DXF 0 s1) "ARC")<br />            (equal (DXF 0 s2) "ARC")<br />            (not (equal s1 s2))<br />       )<br />     (progn<br />       (setq r1  (DXF 40 s1)<br />             r2  (DXF 40 s2)<br />             c1  (DXF 10 s1)<br />             c2  (DXF 10 s2)<br />             sum (+ r1 r2)<br />             dr  (abs (- r1 r2))<br />             dd  (distance c1 c2)<br />       )<br />       (if (or (equal dd sum 1e-6) (equal dd dr 1e-6))<br />         (alert "两弧相切")<br />         (alert "两弧不相切")<br />       )<br />     )<br />   )<br />   (princ)<br /> )

zgs378530220

支持源码。

xyp1964

llsheng_73 发表于 2025-4-24 17:32
好象都有点问题，第一个是强行要求两个圆弧端点重合，不然不进行行判断
院长只计算圆心距与半径和(差)比较 ...

;; 交点法就简单多了

1. (defun c:tt ()
   
2.   (defun DXF (code e) (cdr (assoc code (entget e))))
   
3.   (if (and (setq s1 (car (entsel "\n选择第一条弧<退出>: ")))
   
4.            (setq s2 (car (entsel "\n选择第二条弧<退出>: ")))
   
5.            (equal (DXF 0 s1) "ARC")
   
6.            (equal (DXF 0 s2) "ARC")
   
7.            (not (equal s1 s2))
   
8.            (= (length (xyp-Inters s1 s2 0)) 1);只有一个交点
   
9.            (= (length (xyp-Inters s1 s2 3)) 1);两弧延伸后也只有一个交点
   
10.       )
    
11.     (alert "两弧相切")
    
12.     (alert "两弧不相切")
    
13.   )
    
14.   (princ)
    
15. )

(defun c:tt ()<br />   (defun DXF (code e) (cdr (assoc code (entget e))))<br />   (if (and (setq s1 (car (entsel "\n选择第一条弧<退出>: ")))<br />            (setq s2 (car (entsel "\n选择第二条弧<退出>: ")))<br />            (equal (DXF 0 s1) "ARC")<br />            (equal (DXF 0 s2) "ARC")<br />            (not (equal s1 s2))<br />            (= (length (xyp-Inters s1 s2 0)) 1);只有一个交点<br />            (= (length (xyp-Inters s1 s2 3)) 1);两弧延伸后也只有一个交点<br />       )<br />     (alert "两弧相切")<br />     (alert "两弧不相切")<br />   )<br />   (princ)<br /> )