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