如下图， dwg图中若干图形，运行代码后提示选择两个圆，然后判断两个圆位置关系和相交点坐标:

本例难点在于通过几何知识求出交点坐标。

几何背景

假设有两个圆：
- 圆1：圆心 ( O_1(x_1, y_1) )，半径 ( r_1 )
- 圆2：圆心 ( O_2(x_2, y_2) )，半径 ( r_2 )

圆心 ( O_1 ) 和 ( O_2 ) 之间的距离为 d ，交点位于两圆的公共弦上。我们的目标是通过代数推导找到公共弦与两圆圆心的几何关系，并证明 a 的代数式。

几何分析

两个圆的交点（如果有两个）在公共弦上，且公共弦的中垂线经过两个圆心 O_1  和O_2 的连线。我们定义  P_0 为公共弦的中点，且它在两个圆心连线 O_1O_2 上。定义：
 a 是圆心 O_1到点 P_0  的距离。
h 是P_0 到交点的垂直距离。

因此，我们可以将 a 定义为从 O_1到公共弦 即  P_0 的距离。

利用余弦定理推导 a 

利用两圆的交点与圆心的几何关系，首先计算 \( a \) 的代数表达式。

1. 定义圆心距离 d：

   d = sqrt{(x_2 - x_1)^2 + (y_2 - y_1)^2

   
2. **两圆相交**：假设两个圆有两个交点，公共弦 \( AB \) 将连线 \( O_1O_2 \) 分成两部分：从 \( O_1 \) 到公共弦的距离 \( a \)，和从 \( O_2 \) 到公共弦的另一段距离。

3. **两圆的关系**：根据几何原理，有：

   r_1^2 = a^2 + h^2

   r_2^2 = (d - a)^2 + h^2 

   其中，h 是从 P_0 到交点的垂直距离。

4. 消去  h^2：从公式 (1) 和 (2) 可以消去 \( h^2 \)，得到：

   r_1^2 - a^2 = r_2^2 - (d - a)^2

   
5. **展开并整理**：

   r_1^2 - a^2 = r_2^2 - (d^2 - 2ad + a^2)

   r_1^2 - a^2 = r_2^2 - d^2 + 2ad - a^2

   r_1^2 - r_2^2 + d^2 = 2ad

   
6. 解出  a ：

         a = (r1 ^ 2 - r2 ^ 2 + d ^ 2) / (2 * d)
         h = Sqr(r1 ^ 2 - a ^ 2)
       

通过这个公式，我们可以进一步计算出交点的坐标，根据三角函数，详见代码。

附部分计代码如下：

#If VBA7 Then
  ' 64位系统声明
  Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
  ' 32位系统声明
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
#If VBA7 Then
    ' 64位系统声明
    Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    ' 32位系统声明
    Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
Sub SelectTwoCircles()
'yngqq@2024年9月10日21:40:46
    Dim escapePressed As Boolean
    escapePressed = False
    Dim ent As AcadEntity
    Dim circle1 As AcadCircle
    Dim circle2 As AcadCircle
    Dim selectionCount As Integer
    Dim center1 As Variant
    Dim center2 As Variant
    Dim x1 As Double, y1 As Double, r1 As Double
    Dim x2 As Double, y2 As Double, r2 As Double
    selectionCount = 0

2000:
    Do While selectionCount < 2
        ' 如果按下ESC键，退出循环
        If GetAsyncKeyState(vbKeyEscape) <> 0 Then
        If GetAsyncKeyState(vbKeyEscape) <> 0 Then
            ThisDrawing.Utility.Prompt "检测到ESC键，退出循环 " & vbCrLf
            MsgBox "已按下Esc键,退出程序", , "CopyRight@yngqq"
                GoTo errocontrol
        End If
        End If
        DoEvents
        ThisDrawing.Utility.Prompt "请选择第" & (selectionCount + 1) & "个圆: "
'        If Err Then
'            Err.Clear
'            GoTo 2000
'        End If
        On Error Resume Next
        ThisDrawing.Utility.GetEntity ent, basePnt, " "
        If Err Then
            Err.Clear
            GoTo 2000
        End If
        ' 判断用户是否选择了一个圆
        If TypeOf ent Is AcadCircle Then
            selectionCount = selectionCount + 1
            If selectionCount = 1 Then
                ' 第一个圆
                Set circle1 = ent
            ElseIf selectionCount = 2 Then
                ' 第二个圆
                Set circle2 = ent
            End If
        Else
            ThisDrawing.Utility.Prompt "选择的不是圆，请重新选择。" & vbCrLf
        End If
        
    Loop
    ' 获取圆心坐标和半径
   ' On Error GoTo 0
    center1 = circle1.Center
    center2 = circle2.Center
    x1 = center1(0): y1 = center1(1): r1 = circle1.Radius
    x2 = center2(0): y2 = center2(1): r2 = circle2.Radius
    Call FindCircleIntersection(x1, y1, r1, x2, y2, r2)
errocontrol:
End Sub

Public Function FindCircleIntersection(x1 As Double, y1 As Double, r1 As Double, x2 As Double, y2 As Double, r2 As Double) As Variant
   
    Dim d As Double
    d = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
    
    ' 判断圆的关系
    If d > r1 + r2 Then
        MsgBox "两个圆不相交"
    ElseIf d < Abs(r1 - r2) Then
        MsgBox "一个圆在另一个圆内，且不相交"
    ElseIf d = 0 And r1 = r2 Then
        MsgBox "两个圆重合"
    Else
        ' 圆相交，计算交点
        
        ' 计算 a 和 h
        Dim a As Double, h As Double
        a = (r1 ^ 2 - r2 ^ 2 + d ^ 2) / (2 * d)
        h = Sqr(r1 ^ 2 - a ^ 2)
        
        ' 计算中间点 P0
        Dim P0x As Double, P0y As Double
        P0x = x1 + a * (x2 - x1) / d
        P0y = y1 + a * (y2 - y1) / d
        
        ' 计算两个交点
        Dim x3_1 As Double, y3_1 As Double
        Dim x3_2 As Double, y3_2 As Double
        
        x3_1 = P0x + h * (y2 - y1) / d
        y3_1 = P0y - h * (x2 - x1) / d
        
        x3_2 = P0x - h * (y2 - y1) / d
        y3_2 = P0y + h * (x2 - x1) / d
        
        ' 输出交点坐标
        If d = r1 + r2 Or d = Abs(r1 - r2) Then
            MsgBox "两个圆相切，交点坐标为：" & vbCrLf & "(" & x3_1 & "   ,   " & y3_1 & ")"
        Else
            MsgBox "两个圆相交，交点坐标为：" & vbCrLf & "(" & x3_1 & "   ,   " & y3_1 & ")" & vbCrLf & "和" & vbCrLf & "(" & x3_2 & "   ,   " & y3_2 & ")"
        End If
    End If
End Function

 

CAD二次开发、插件、代码代写，详情见下方↓