Circle Packing
Windows only
Multi-radius circle packing algorithm in RhinoScript.
Option Explicit
'Script written by Steven Janssen
'Script copyrighted by Steven Janssen
'Script version Sunday, 18 May 2008 11:34:18 AM
Call Main()
Sub Main()
Dim arrPoint(), arrRadius(), intCircleNumber, arrInputR, arrSide(2)
Dim strCurrentCircleID, R, intCurrentCentre, k
Dim dblCosA, dblRotA
Dim checkdistanceA, checkdistanceB, checkloop, marker, intHole
'Get Input Circles
arrInputR = Rhino.GetObjects("Select Circles", 4)
If Not IsArray(arrInputR) Then
Exit Sub
End If
'Get Radii from Input Circles
For R = 0 To Ubound(arrInputR)
If Rhino.IsCircle(arrInputR(R)) Then
arrInputR(R) = Rhino.CircleRadius(arrInputR(R))
End If
Next
intCircleNumber = Rhino.GetInteger("Number of Circles",1000)
intCircleNumber = intCircleNumber - 1
ReDim arrPoint(intCircleNumber)
ReDim arrRadius(intCircleNumber)
'Draw 1st Circle
arrRadius(0) = arrInputR(Int(RND*(Ubound(arrInputR)+1)))
arrPoint(0) = Rhino.GetPoint("Centre of Circle")
If Not IsArray(arrPoint(0)) Then
Exit Sub
End If
strCurrentCircleID = Rhino.AddCircle(Array(arrPoint(0),Array(1,0,0),Array(0,1,0),Array(0,0,1)),arrRadius(0))
Rhino.EnableRedraw vbFalse
'Draw 2nd Circle
arrRadius(1) = arrInputR(Int(RND*(Ubound(arrInputR)+1)))
arrPoint(1) = arrPoint(0)
arrPoint(1)(0) = arrPoint(1)(0) + arrRadius(0) + arrRadius(1)
strCurrentCircleID = Rhino.AddCircle(Array(arrPoint(1),Array(1,0,0),Array(0,1,0),Array(0,0,1)),arrRadius(1))
intCurrentCentre = 0
intHole = 1
'Draw other Circles
For k = 2 To intCircleNumber
Rhino.StatusBarMessage k+1 & "/" & intCircleNumber+1
arrRadius(k) = arrInputR(Int(RND*(Ubound(arrInputR)+1)))
Do
marker = 0
'Calculate the lengths of the sides
arrSide(0) = Rhino.distance(arrPoint(intCurrentCentre), arrPoint(k-intHole))
arrSide(1) = arrRadius(k) + arrRadius(intCurrentCentre)
arrSide(2) = arrRadius(k) + arrRadius(k-intHole)
'Calculate Angle
dblCosA = (arrSide(0)^2 + arrSide(1)^2 - arrSide(2)^2) / (2 * arrSide(0) * arrSide(1))
If dblCosA > 1 Then
marker = 1
Else
dblRotA = Atn(-dblCosA / Sqr((-dblCosA * dblCosA) + 1)) + (2 * Atn(1))
dblRotA = Rhino.ToDegrees(dblRotA)
'Create, rotate and scale Vector
arrPoint(k) = Rhino.VectorCreate(arrPoint(k-intHole),arrPoint(intCurrentCentre))
arrPoint(k) = Rhino.VectorRotate(arrPoint(k),dblRotA,Array(0,0,1))
arrPoint(k) = Rhino.VectorScale(arrPoint(k),(arrSide(1)/arrSide(0)))
arrPoint(k) = Rhino.VectorAdd(arrPoint(k),arrPoint(intCurrentCentre))
'Check if Circle will Intersect with Existing Circles
For checkloop = (k-1) To 0 Step -1
checkdistanceA = Rhino.distance(arrPoint(k), arrPoint(checkloop)) + 0.001
checkdistanceB = (arrRadius(k) + arrRadius(checkloop))
If checkdistanceA < checkdistanceB Then
marker = 1
Exit For
End If
Next
If marker = 0 Then
'rhino.AddLine arrPoint(k-intHole), arrPoint(k)
strCurrentCircleID = Rhino.AddCircle(Array(arrPoint(k),Array(1,0,0),Array(0,1,0),Array(0,0,1)),arrRadius(k))
End If
End If
'Exit the Do Loop if the Circle is Good
If marker = 0 Then
intHole = 1
Exit Do
End If
intCurrentCentre = intCurrentCentre + 1
If intCurrentCentre = k-intHole Then
intHole = intHole + 1
intCurrentCentre = 0
'If intHole > 2 Then
' rhino.addpoint arrPoint(k-intHole)
'End If
'rhino.messagebox intHole
End If
Loop
Next
Rhino.EnableRedraw vbTrue
End Sub