Try this one
Public Function GetTwoCirclesInters(p1 As Variant, p2 As Variant, r1 As Double, r2 As Double) As Variant
Dim dis As Double
Dim ip1 As Variant
Dim ip2 As Variant
Dim inters(0 To 1, 0 To 2) As Double
With ThisDrawing.Utility
dis = Distance(p1, p2)
If dis > r1 + r2 Then
GetTwoCirclesInters = Null
Exit Function
ElseIf dis >= r1 + r2 + 0.000000000001 Then '<--fuzz
ip1 = .PolarPoint(p1, .AngleFromXAxis(p1, p2), r1)
ip2 = .PolarPoint(p1, .AngleFromXAxis(p1, p2), r1)
Else
Dim cosinA As Double
Dim ang As Double
cosinA = (((r1 * r1) + (dis * dis)) - (r2 * r2)) / (2# * r1 * dis)
ang = Atn((Sqr(1 - (cosinA * cosinA))) / cosinA)
ip1 = .PolarPoint(p1, .AngleFromXAxis(p1, p2) + ang, r1)
ip2 = .PolarPoint(p1, .AngleFromXAxis(p1, p2) - ang, r1)
inters(0, 0) = ip1(0): inters(0, 1) = ip1(1): inters(0, 2) = ip1(2)
inters(1, 0) = ip2(0): inters(1, 1) = ip2(1): inters(1, 2) = ip2(2)
End If
End With
GetTwoCirclesInters = inters
End Function
Function Distance(p1 As Variant, p2 As Variant) As Double
Distance = Sqr((p1(0) - p2(0)) ^ 2 + ((p1(1) - p2(1)) ^ 2))
End Function
Sub test()
Dim p1(2) As Double
Dim p2(2) As Double
Dim r1 As Double
Dim r2 As Double
p1(0) = 0#: p1(1) = 0#: p1(2) = 0#:
p2(0) = -500#: p2(1) = -500#: p2(2) = 0#
r1 = 600#: r2 = 300#
Dim inters As Variant
inters = GetTwoCirclesInters(p1, p2, r1, r2)
Dim ip1(2) As Double
Dim ip2(2) As Double
ip1(0) = inters(0, 0): ip1(1) = inters(0, 1): ip1(2) = inters(0, 2)
ip2(0) = inters(1, 0): ip2(1) = inters(1, 1): ip2(2) = inters(1, 2)
ThisDrawing.ModelSpace.AddLine ip1, ip2
End Sub
~'J'~