如下图， 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:46Dim escapePressed As BooleanescapePressed = FalseDim ent As AcadEntityDim circle1 As AcadCircleDim circle2 As AcadCircleDim selectionCount As IntegerDim center1 As VariantDim center2 As VariantDim x1 As Double, y1 As Double, r1 As DoubleDim x2 As Double, y2 As Double, r2 As DoubleselectionCount = 02000:Do While selectionCount < 2' 如果按下ESC键，退出循环If GetAsyncKeyState(vbKeyEscape) <> 0 ThenIf GetAsyncKeyState(vbKeyEscape) <> 0 ThenThisDrawing.Utility.Prompt "检测到ESC键，退出循环 " & vbCrLfMsgBox "已按下Esc键,退出程序", , "CopyRight@yngqq"GoTo errocontrolEnd IfEnd IfDoEventsThisDrawing.Utility.Prompt "请选择第" & (selectionCount + 1) & "个圆: "
' If Err Then
' Err.Clear
' GoTo 2000
' End IfOn Error Resume NextThisDrawing.Utility.GetEntity ent, basePnt, " "If Err ThenErr.ClearGoTo 2000End If' 判断用户是否选择了一个圆If TypeOf ent Is AcadCircle ThenselectionCount = selectionCount + 1If selectionCount = 1 Then' 第一个圆Set circle1 = entElseIf selectionCount = 2 Then' 第二个圆Set circle2 = entEnd IfElseThisDrawing.Utility.Prompt "选择的不是圆，请重新选择。" & vbCrLfEnd IfLoop' 获取圆心坐标和半径' On Error GoTo 0center1 = circle1.Centercenter2 = circle2.Centerx1 = center1(0): y1 = center1(1): r1 = circle1.Radiusx2 = center2(0): y2 = center2(1): r2 = circle2.RadiusCall FindCircleIntersection(x1, y1, r1, x2, y2, r2)
errocontrol:
End SubPublic Function FindCircleIntersection(x1 As Double, y1 As Double, r1 As Double, x2 As Double, y2 As Double, r2 As Double) As VariantDim d As Doubled = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)' 判断圆的关系If d > r1 + r2 ThenMsgBox "两个圆不相交"ElseIf d < Abs(r1 - r2) ThenMsgBox "一个圆在另一个圆内，且不相交"ElseIf d = 0 And r1 = r2 ThenMsgBox "两个圆重合"Else' 圆相交，计算交点' 计算 a 和 hDim a As Double, h As Doublea = (r1 ^ 2 - r2 ^ 2 + d ^ 2) / (2 * d)h = Sqr(r1 ^ 2 - a ^ 2)' 计算中间点 P0Dim P0x As Double, P0y As DoubleP0x = x1 + a * (x2 - x1) / dP0y = y1 + a * (y2 - y1) / d' 计算两个交点Dim x3_1 As Double, y3_1 As DoubleDim x3_2 As Double, y3_2 As Doublex3_1 = P0x + h * (y2 - y1) / dy3_1 = P0y - h * (x2 - x1) / dx3_2 = P0x - h * (y2 - y1) / dy3_2 = P0y + h * (x2 - x1) / d' 输出交点坐标If d = r1 + r2 Or d = Abs(r1 - r2) ThenMsgBox "两个圆相切，交点坐标为：" & vbCrLf & "(" & x3_1 & " , " & y3_1 & ")"ElseMsgBox "两个圆相交，交点坐标为：" & vbCrLf & "(" & x3_1 & " , " & y3_1 & ")" & vbCrLf & "和" & vbCrLf & "(" & x3_2 & " , " & y3_2 & ")"End IfEnd If
End Function
CAD二次开发、插件、代码代写，详情见下方↓
