topic Re: CIRCLE CIRCLE INTERSECTION in VBA Forum

CIRCLE CIRCLE INTERSECTION

Anonymous — Fri, 21 Mar 2008 19:56:36 GMT

ANY WIZ KIDS OUT THERE? GIVEN X1, Y1 AND X2, Y2 AND RADIUS1 AND RADIUS2

IS THERE A SIMPLE WAY TO CALCULATE THE TWO INTERSECTIONS WITHOUT ACTUALLY DRAWING TWO CIRCLES IN AUTOCAD?

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Fri, 21 Mar 2008 21:52:36 GMT

Don't shout, please

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Fri, 21 Mar 2008 21:53:18 GMT

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'~

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Fri, 21 Mar 2008 23:34:52 GMT

Fatty,

msgbox "YOU ARE THE MAN"

I always had to draw two circles then then draw lines from the intersect points. I have to do this many times a day. Thank you very^100 much!

God Bless

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Sat, 22 Mar 2008 02:12:33 GMT

Wouldn't it be as easy as...

If the distance from pt1 to pt2 is less than or equal to the sum of radius1
and radius2 then they intersect?

Jim Dee
www.caddee.com

wrote in message
news:5882860@discussion.autodesk.com...
Fatty,

msgbox "YOU ARE THE MAN"

I always had to draw two circles then then draw lines from the intersect
points. I have to do this many times a day. Thank you very^100 much!

God Bless

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Sat, 22 Mar 2008 03:41:14 GMT

Oh, my bad
Yes, you are right, CADDee 🙂

Instead of:
If dis > r1 + r2 Then
GetTwoCirclesInters = Null
must be:
If dis < r1 + r2 Then
GetTwoCirclesInters = Null

Thank you

~'J'~

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Sat, 22 Mar 2008 03:42:46 GMT

Please, change it as I wrote abow
Glad to help

~'J'~ Message was edited by: Fatty

Re: CIRCLE CIRCLE INTERSECTION

jbooth — Mon, 24 Mar 2008 14:49:11 GMT

Depends on your definition of "easy".

http://local.wasp.uwa.edu.au/~pbourke/geometry/2circle/

Re: CIRCLE CIRCLE INTERSECTION

Anonymous — Mon, 24 Mar 2008 17:54:28 GMT

Agreed, it's easier a bit:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Option Explicit

Function Get_Dist(p1 As Variant, p2 As Variant) As Double
Get_Dist = Sqr((p1(0) - p2(0)) ^ 2 + ((p1(1) - p2(1)) ^ 2))
End Function
Sub testcircles()
' uses algorithm from here:
' http://local.wasp.uwa.edu.au/~pbourke/geometry/2circle/
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oCircle As AcadCircle
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfCode, dxfValue

Dim rad1 As Double
Dim rad2 As Double
Dim segm As Double
Dim hgt As Double
Dim dis As Double

Dim p1 As Variant
Dim p2 As Variant
Dim p3 As Variant
Dim p4(2) As Double
Dim p5(2) As Double

Dim x4 As Double
Dim y4 As Double
Dim x5 As Double
Dim y5 As Double
Dim z As Double

fcode(0) = 0
fData(0) = "CIRCLE"

dxfCode = fcode
dxfValue = fData
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
End With
With ThisDrawing.SelectionSets
Set oSset = .Add("$mycircles$")
End With
ThisDrawing.Utility.Prompt (vbCrLf & "Select two circles")
oSset.SelectOnScreen dxfCode, dxfValue
If oSset.Count <> 2 Then
MsgBox "Wrong number of circles selected" & vbCr & _
"Try again"
End If

Set oEnt = oSset.Item(0)
Set oCircle = oEnt
rad1 = oCircle.Radius
p1 = oCircle.Center

Set oEnt = oSset.Item(1)
Set oCircle = oEnt
rad2 = oCircle.Radius
p2 = oCircle.Center
dis = Get_Dist(p1, p2)

segm = ((rad1 ^ 2 - rad2 ^ 2) + dis ^ 2) / (dis * 2)
hgt = Sqr(Abs(rad1 ^ 2 - segm ^ 2))
With ThisDrawing.Utility
p3 = ThisDrawing.Utility.PolarPoint(p1, .AngleFromXAxis(p1, p2), segm)
End With
x4 = p3(0) + (hgt * (p1(1) - p2(1))) / dis
y4 = p3(1) - (hgt * (p1(0) - p2(0))) / dis
x5 = p3(0) - (hgt * (p1(1) - p2(1))) / dis
y5 = p3(1) + (hgt * (p1(0) - p2(0))) / dis
p4(0) = x4: p4(1) = y4: p4(2) = 0#
p5(0) = x5: p5(1) = y5: p5(2) = 0#

ThisDrawing.ModelSpace.AddLine p4, p5

End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

~'J'~