This Rhino Script allows the user to pack a series of curves into a set boundary with several options for scaling, orientation, sorting, and numbering.
Rhino Script
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Wednesday, April 30, 2008 4:08:50 PM
Call Main()
Sub Main()
Dim objects,inputs,width,height,scale,boarder
objects = Rhino.GetObjects("Select Curves")
If isNull(objects) Then Exit Sub
Dim i,r,s, blnGrp(), grp,ngrp, count
grp = False: ngrp = False
i = 0: r = 0: s = 0
ReDim blnGrp(uBound(objects))
Dim groups, obj(), grps()
ReDim grps(r),obj(s)
For i = 0 To uBound(objects) Step 1
If Rhino.IsObjectInGroup(objects(i)) Then
ReDim Preserve grps(r)
grps(r) = objects(i)
grp = True
r = r + 1
Else
ReDim Preserve obj(s)
obj(s) = objects(i)
blnGrp(s) = False
ngrp = True
s = s + 1
End If
Next
s = 0
If grp = True And ngrp = False Then
ReDim blnGrp(0)
inputs = groupsFromObjects(objects)
For i = 0 To uBound(inputs) Step 1
ReDim Preserve blnGrp(i)
blnGrp(i) = True
Next
End If
If ngrp = True And grp = False Then
inputs = objects
For i = 0 To uBound(inputs) Step 1
blnGrp(i) = False
Next
End If
If grp = True And ngrp = True Then
groups = groupsFromObjects(grps)
count = uBound(groups) + uBound(obj) + 1
ReDim inp(count)
For i = 0 To uBound(groups) Step 1
inp(s) = groups(i)
blnGrp(s) = True
s = s + 1
Next
For i = 0 To uBound(obj) Step 1
inp(s) = obj(i)
blnGrp(s) = False
s = s + 1
Next
inputs = inp
End If
Dim arrItems, arrValues, arrReturns
arrItems = array("Maximum_Width", "Maximum_Height", "Scale_Factor", "Boarder_Width", "Rotational_Alignment", "World_Orientation")
arrValues = array(32, 18, 1, .25, True, True)
arrReturns = Rhino.PropertyListBox(arrItems, arrValues,, "Transform Parameters")
If isNull(arrReturns) Then Exit Sub
Call Rhino.EnableRedraw(False)
Call TileCurves(inputs, CDbl(arrReturns(0)), CDbl(arrReturns(1)), CDbl(arrReturns(2)), CDbl(arrReturns(3)), CBool(arrReturns(4)), CBool(arrReturns(5)), blnGrp)
Call Rhino.EnableRedraw(True)
End Sub
Function TileCurves(curves, width, height, scale, board, align, orient, group)
TileCurves = Null
Dim i,j,k,r,s,t,u,v,a,stps,count
count = uBound(curves)
Dim tempCv,testCv,wPlane,sort,minH,minR,tBox,tempTxt
wPlane = Rhino.WorldXYPlane()
ReDim bBox(count),wid(count),hgt(count),obj(count),centPt(count),cutObj(count),txtH(count),lblH(count)
ReDim h(count),w(count),c(count),cA(count),rotVal(count)
ReDim areaV(89)
If Rhino.IsLayer("scores") = False Then
Call Rhino.AddLayer("scores", RGB(255, 0, 0))
End If
If Rhino.IsLayer("labels") = False Then
Call Rhino.AddLayer("labels", RGB(0, 0, 0))
End If
If Rhino.IsLayer("cuts") = False Then
Call Rhino.AddLayer("cuts", RGB(0, 255, 0))
End If
If Rhino.IsLayer("frame") = False Then
Call Rhino.AddLayer("frame", RGB(0, 0, 0))
End If
'create cutting reference box
Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(0, 0, 0), array(0, height, 0), array(width, height, 0), array(width, 0, 0), array(0, 0, 0))), "frame")
Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(board, board, 0), array(board, height - board, 0), array(width - board, height - board, 0), array(width - board, board, 0), array(board, board, 0))), "frame")
'determine boundry dimensions and copy object for packing
Dim oPts, obox, oArea(), oMin
For i = 0 To count Step 1
If group(i) = True Then
testCv = Rhino.CopyObjects(curves(i))
Else
testCv = Rhino.CopyObject(curves(i))
End If
'search for optimal orientation based on curve points, optimal for boxes.
' Will Not Work If Objects Are Grouped!
If group(i) = False Then
If orient = True Then
oPts = Rhino.CurveEditPoints(testCv)
s = 0
ReDim oArea(s), oOri(s)
For j = 0 To uBound(oPts) - 1 Step 1
For k = j To uBound(oPts) - 1 Step 1
If j <> k Then
ReDim Preserve oArea(s), oOri(s)
oPts = Rhino.CurveEditPoints(testCv)
oOri(s) = array(j, k)
Call Rhino.OrientObject(testCv, array(oPts(j), oPts(k)), array(oPts(j), array(oPts(j)(0), oPts(j)(1) + 1, oPts(j)(2))))
obox = Rhino.BoundingBox(testCv)
oArea(s) = Rhino.Distance(obox(0), obox(1)) * Rhino.Distance(obox(0), obox(3))
s = s + 1
End If
Next
Next
oMin = Rhino.Min(oArea)
k = 0: j = 0
Do Until j = s Or k = 1
If oArea(j) = oMin Then
oPts = Rhino.CurveEditPoints(testCv)
Call Rhino.OrientObject(testCv, array(oPts(oOri(j)(0)), oPts(oOri(j)(1))), array(oPts(oOri(j)(0)), array(oPts(oOri(j)(0))(0), oPts(oOri(j)(0))(1) + 1, oPts(oOri(j)(0))(2))))
k = 1
End If
j = j + 1
Loop
End If
End If
bBox(i) = Rhino.BoundingBox(testCv)
tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
centPt(i) = Rhino.CurveMidPoint(tempCv)
Call Rhino.DeleteObject(tempCv)
If align = True Then
For j = 0 To 89 Step 1
If group(i) = True Then
Call Rhino.RotateObjects(testCv, centPt(i), 1, wPlane(3))
Else
Call Rhino.RotateObject(testCv, centPt(i), 1, wPlane(3))
End If
tBox = Rhino.BoundingBox(testCv)
areaV(j) = Rhino.Distance(tBox(0), tBox(1)) * Rhino.Distance(tBox(0), tBox(3))
Next
If group(i) = True Then
Call Rhino.RotateObjects(testCv, centPt(i), -89, wPlane(3))
Else
Call Rhino.RotateObject(testCv, centPt(i), -89, wPlane(3))
End If
minR = Rhino.Min(areaV)
For j = 0 To 89 Step 1
If areaV(j) = minR Then
rotVal(i) = j
End If
Next
End If
obj(i) = testCv
If align = True Then
If group(i) = True Then
Call Rhino.RotateObjects(obj(i), centPt(i), rotVal(i), wPlane(3))
Else
Call Rhino.RotateObject(obj(i), centPt(i), rotVal(i), wPlane(3))
End If
End If
bBox(i) = Rhino.BoundingBox(obj(i))
wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
txtH(i) = hgt(i)
'scale packing objects and rotate to maximize packing
If wid(i) < hgt(i) Then
txtH(i) = wid(i)
If group(i) = True Then
Call Rhino.RotateObjects(obj(i), centPt(i), 90, wPlane(3))
Else
Call Rhino.RotateObject(obj(i), centPt(i), 90, wPlane(3))
End If
End If
If group(i) = True Then
Call Rhino.ScaleObjects(obj(i), centPt(i), array(scale, scale, 1))
Else
Call Rhino.ScaleObject(obj(i), centPt(i), array(scale, scale, 1))
End If
bBox(i) = Rhino.BoundingBox(obj(i))
tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
centPt(i) = Rhino.CurveMidPoint(tempCv)
Call Rhino.DeleteObject(tempCv)
wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
Next
If Rhino.Max(wid) - Rhino.Min(wid) > Rhino.Max(hgt) - Rhino.Min(hgt) Then
For i = 0 To count Step 1
If group(i) = True Then
Call Rhino.RotateObjects(obj(i), centPt(i), 90, wPlane(3))
Else
Call Rhino.RotateObject(obj(i), centPt(i), 90, wPlane(3))
End If
bBox(i) = Rhino.BoundingBox(obj(i))
tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
centPt(i) = Rhino.CurveMidPoint(tempCv)
Call Rhino.DeleteObject(tempCv)
wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
Next
v = True
Else
v = False
End If
sort = Rhino.SortNumbers(wid, False)
minH = Rhino.Min(hgt)
If minH < .1 Then
minH = .1
End If
'conditional reDimensions array through an elimination process preventing duplicates
Dim tmpObj,tmpWid,blnMe
tmpObj = obj
tmpWid = wid
For i = 0 To count Step 1
a = 0
blnMe = False
For j = 0 To count - i Step 1
If sort(i) = tmpWid(j) And blnMe = False Then
cutObj(i) = tmpObj(j)
blnMe = True
Else
tmpObj(a) = tmpObj(j)
tmpWid(a) = tmpWid(j)
txtH(a) = txtH(j)
a = a + 1
End If
Next
ReDim Preserve tmpObj(count-i-1)
ReDim Preserve tmpWid(count-i-1)
Next
'Resequence according to scale to maximize wasted space
For i = 0 To count Step 1
bBox(i) = Rhino.BoundingBox(cutObj(i))
tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
c(i) = Rhino.CurveMidPoint(tempCv)
h(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
w(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
Call Rhino.DeleteObject(tempCv)
Call Rhino.ObjectLayer(cutObj(i), "cuts")
Next
'check that objects are within frame dimensions
For i = 0 To count Step 1
If h(i) > height - board * 2 Then
Call Rhino.Print("Object to Large to Cut")
Call Rhino.ObjectColor(cutObj(i), RGB(255, 255, 255))
Exit Function
End If
If w(i) > width - board * 2 Then
Call Rhino.Print("Object to Large to Cut")
Call Rhino.ObjectColor(cutObj(i), RGB(255, 255, 255))
Exit Function
End If
Next
'pack according to dimensional limits
r = board
s = board
t = 0
u = 0
Dim lblTxt, xbox, xln
For i = 0 To count Step 1
xbox = Rhino.BoundingBox(curves(i))
xln = Rhino.AddLine(xbox(0), xbox(2))
lblTxt = Rhino.AddText(i, Rhino.CurveMidPoint(xln), txtH(count - i) * .5)
Call Rhino.DeleteObject(xln)
Call Rhino.ObjectLayer(lblTxt, "labels")
If s + board + h(i) > height - board Then
s = board
r = r + t + w(i) * .5
t = w(i) * .5
End If
If r + w(i) * .5 > width*u+width - board * 2 Then
u = u + 1
r = width * u + board + w(i) * .5
Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width * u, 0, 0), array(width * u, height, 0), array(width * u + width, height, 0), array(width * u + width, 0, 0), array(width * u, 0, 0))), "frame")
Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width * u + board, board, 0), array(width * u + board, height - board, 0), array(width * u + width - board, height - board, 0), array(width * u + width - board, board, 0), array(width * u + board, board, 0))), "frame")
End If
If i = 0 Then
r = board + w(i) * .5
s = board + h(i) * .5
t = w(i) * .5
If group(i) = True Then
Call Rhino.moveobjects(cutObj(i), c(i), array(r, s, 0))
Else
Call Rhino.moveobject(cutObj(i), c(i), array(r, s, 0))
End If
cA(i) = array(board, board, 0)
s = s + h(i) * .5
Else
s = s + h(i) * .5
If group(i) = True Then
Call Rhino.moveobjects(cutObj(i), c(i), array(r, s, 0))
Else
Call Rhino.moveobject(cutObj(i), c(i), array(r, s, 0))
End If
cA(i) = array(r - w(i) * .5, s - h(i) * .5, 0)
s = s + h(i) * .5
End If
If v = False Then
Call Rhino.ObjectLayer(Rhino.AddText(i, cA(i), txtH(count - i) * scale * .5),"scores")
Else
tempTxt = Rhino.AddText(i, array(cA(i)(0) + w(i), cA(i)(1), cA(i)(2)), txtH(count - i) * scale * .5)
Call Rhino.ObjectLayer(tempTxt, "scores")
Call Rhino.RotateObject(tempTxt, array(cA(i)(0) + w(i), cA(i)(1), cA(i)(2)), 90, wPlane(3))
End If
Next
End Function
Function groupsFromObjects(obj)
groupsFromObjects = Null
Dim i,j,r,s, count, grp, box, grpObj()
count = uBound(obj)
ReDim grp(count), group(0)
s = 0
For i = 0 To count Step 1
grp(i) = Rhino.ObjectTopGroup(obj(i))
If i > 0 Then
r = 0
j = 0
Do Until j = s
If grp(i) <> group(j) Then
r = r + 1
End If
j = j + 1
Loop
If r = s Then
ReDim Preserve group(s)
group(s) = grp(i)
s = s + 1
End If
Else
group(s) = grp(i)
s = 1
End If
Next
ReDim grpObj(uBound(group))
For i = 0 To uBound(group) Step 1
grpObj(i) = Rhino.ObjectsByGroup(group(i))
Next
groupsFromObjects = grpObj
End Function