已知两圆的圆心半径，求交点坐标（几何代数两种解法）——CAD VBA 解决

大家好，欢迎来到IT知识分享网。

本文用几何和代数两种算法，分别求出两圆相交点坐标。

一、几何法

如下图， 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() 'yng@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@yng" 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 

二、代数法：

已知：圆1坐标（a1,b1），半径a，圆1坐标（a2,b2），半径b:
那么两个圆的标准方程式 (即所有符合条件的xy在圆上):
方程1：(x-a1）^2  + (y-b1）^2  = r1^2
方程2：(x-a2）^2  + (y-b2）^2  = r2^2
两个圆交点的xy坐标即满足方程1，又满足方程2,所以交点坐标可以把联立方程1、2求得：
（
    ①：(x-a1）^2  + (y-b1）^2  = r1^2
    ②：(x-a2）^2  + (y-b2）^2  = r2^2
）
①②联系得③: y = AX + B
简化下公式:
③代入①，即一元二次方程，根据求根公式，即可得到相交点坐标x1，x2
y可带入公式 y = A * x + B求解
 y1 = A * x1 + B
 y2 = B * x2 + B
注意：这里圆心坐标a1,a2,程序里圆心坐标是x1,x2，注意转换问题。
程序运行如下：

 附部分代码：

#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() 'yng@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@yng" End If End If DoEvents ThisDrawing.Utility.Prompt "请选择第" & (selectionCount + 1) & "个圆: " 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) 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 ' 圆相交，计算交点 ' 计算两个交点 Dim x3_1 As Double, y3_1 As Double Dim x3_2 As Double, y3_2 As Double Dim A As Double, B As Double, AA As Double, BB As Double, CC As Double '定义四个中间参数 A = (x2 - x1) / (y1 - y2) B = (r1 ^ 2 - r2 ^ 2 + x2 ^ 2 + y2 ^ 2 - x1 ^ 2 - y1 ^ 2) / (2 * (y2 - y1)) AA = 1 + A ^ 2 BB = (2 * A * B - 2 * x1 - 2 * A * y1) CC = x1 ^ 2 + B ^ 2 - 2 * y1 * B + y1 ^ 2 - r1 ^ 2 MsgBox (BB ^ 2 - 4 * AA * CC) x3_1 = (-1 * BB + Sqr(BB ^ 2 - 4 * AA * CC)) / (2 * AA) x3_2 = (-1 * BB - Sqr(BB ^ 2 - 4 * AA * CC)) / (2 * AA) 'y可带入公式 y = A * x + B求解 y3_1 = A * x3_1 + B y3_2 = A * x3_2 + B ' 输出交点坐标 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 ' '已知：圆1坐标（a1,b1），半径a，圆1坐标（a2,b2），半径b: '那么两个圆的标准方程式 (即所有符合条件的xy在圆上): '方程1：(x-a1）^2 + (y-b1）^2 = r1^2 '方程2：(x-a2）^2 + (y-b2）^2 = r2^2 '两个圆交点的xy坐标即满足方程1，又满足方程2,所以交点坐标可以把联立方程1、2求得： '（ ' ①：(x-a1）^2 + (y-b1）^2 = r1^2 ' ②：(x-a2）^2 + (y-b2）^2 = r2^2 '） '①②联系得③: y = AX + B '简化下公式: '③代入①，即一元二次方程，根据求根公式，即可得到相交点坐标x1，x2 'y可带入公式 y = a * x + B求解 ' y1 = A * x1 + B ' y2 = B * x2 + B '注意：这里圆心坐标a1,a2,程序里圆心坐标是x1,x2，注意转换问题。 

草稿纸：

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