Pack It

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