Triangulate Strips

This simple triangulation fabrication script takes a single surface and evaluates it at a user-specified density.  The script then creates a flattened set of strip templates for printing/ laser cutting which are numbered for easy assembly.

Rhino Script

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Saturday, March 07, 2009 6:11:13 PM

Call Main()
Sub Main()
	Dim surface, arrValue
	Dim cols, rows, dept, spac
	surface = Rhino.GetObject("Select Surface", 8, True)
	If isnull(surface) Then Exit Sub
	
	arrValue = Rhino.PropertyListBox(array("Columns", "Rows", "TabHeight", "Spacing"), array(10, 10, 2, 2), "Surface Parameters", "Input Parameters")
	If isNull(arrValue) Then Exit Sub
	
	cols = CDbl(arrValue(0))
	rows = CDbl(arrValue(1))
	dept = CDbl(arrValue(2))
	spac = CDbl(arrValue(3))
	
	Call reparameterize(surface)
	Call Rhino.EnableRedraw(False)
	
	Dim triangles, cuts, tile, tabs, tri, strip
	triangles = triangulate(surface, cols, rows)
	cuts = reOrient(triangles)
	tri = drawTriangle(triangles)
	strip = makeStrips(cuts)
	tile = tileObject(strip, spac + dept)
	
	
	Dim i,j,k,r,s,t
	For i = 0 To ubound(triangles) Step 1
		r = 0
		s = 0
		For j = 0 To ubound(triangles(i)) Step 1
			If j Mod (2) Then
				s = s + 1
				t = i + 1
				If j > 0 Then
					Call Rhino.DeleteObject(cuts(i)(j)(0))
				End If
				If j < ubound(triangles(i)) Then
					Call Rhino.ObjectColor(cuts(i)(j)(1), RGB(255, 0, 0))
				End If
			Else
				r = r + 1
				t = i
				If j > 0 Then
					Call Rhino.DeleteObject(cuts(i)(j)(1))
				End If
				Call Rhino.ObjectColor(cuts(i)(j)(0), RGB(255, 0, 0))
			End If
			
			tabs = tabmaker(cuts(i)(j)(2), dept, CStr("2." &amp; i &amp; "." &amp; r))
			Call labelEdge(tri(i)(j)(2), CStr("2." &amp; t &amp; "." &amp; r))
			Call Rhino.ObjectColor(cuts(i)(j)(2), RGB(255, 0, 0))
			Call Rhino.AddSrfPt(triangles(i)(j))
		Next
	Next
	
	Call Rhino.EnableRedraw(True)
	
End Sub
Function drawTriangle(arrPoints)
	drawTriangle = Null
	Dim i,j,k
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k), arrPoints(i)(j)(k + 1))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next
	
	drawTriangle = arrOutput
End Function
Function reOrient(arrPoints)
	reOrient = Null
	Dim i,j,k
	Dim cPlane, wplane
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k), arrPoints(i)(j)(k + 1))
				Call Rhino.OrientObject(crv(k), array(arrPoints(i)(j)(0), arrPoints(i)(j)(1), arrPoints(i)(j)(2)), array(array(0, 0, 0), array(1, 0, 0), array(0, 1, 0)))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next
	
	reOrient = arrOutput
End Function
Function makeStrips(arrObjects)
	makeStrips = Null
	Dim arrOutput(), arrVal()
	ReDim arrOutput(ubound(arrObjects))
	Dim i,j,k,r
	Dim ptA(2), ptB(2)
	For i = 0 To ubound(arrObjects) Step 1
		r = 0
		ReDim arrVal(r)
		For j = 0 To ubound(arrObjects(i)) - 1 Step 1
			If j Mod (2) Then
				ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j + 1)(1))
				ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j + 1)(1))
				ptA(2) = array(ptA(0)(0), ptA(0)(1), ptA(0)(2) + 1)
			
				ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(1))
				ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(1))
				ptB(2) = array(ptB(0)(0), ptB(0)(1), ptB(0)(2) + 1)
			Else
				ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j + 1)(0))
				ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j + 1)(0))
				ptA(2) = array(ptA(0)(0), ptA(0)(1), ptA(0)(2) + 1)
			
				ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(0))
				ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(0))
				ptB(2) = array(ptB(0)(0), ptB(0)(1), ptB(0)(2) + 1)
			End If
			
			Call Rhino.OrientObjects(arrObjects(i)(j + 1), ptA, ptB)
			If j = 0 Then
				For k = 0 To ubound(arrObjects(i)(j)) Step 1
					ReDim Preserve arrVal(r)
					arrVal(r) = arrObjects(i)(j)(k)
					r = r + 1
				Next
			End If
			For k = 0 To ubound(arrObjects(i)(j + 1)) Step 1
				ReDim Preserve arrVal(r)
				arrVal(r) = arrObjects(i)(j + 1)(k)
				r = r + 1
			Next
		Next
		arrOutput(i) = arrVal
	Next
	makeStrips = arrOutput
End Function
Function tabMaker(curve, depth, text)
	tabMaker = Null
	Dim arrOutput, pt(3), txt
	pt(0) = Rhino.CurveMidPoint(curve)
	pt(1) = Rhino.CurveStartPoint(curve)
	pt(2) = Rhino.CurveEndPoint(curve)
	pt(3) = Rhino.PointAdd(pt(0), Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(pt(1), pt(2))), depth), 90, Rhino.WorldXYPlane()(3)))
	arrOutput = Rhino.AddPolyline(array(pt(1), pt(3), pt(2)))
	txt = Rhino.AddText(text, pt(0), depth * 0.3)
	Call Rhino.ObjectColor(txt, RGB(0, 255, 0))
	Call Rhino.OrientObject(txt, array(pt(0), array(pt(0)(0) + 1, pt(0)(1), pt(0)(2)), array(pt(0)(0), pt(0)(1) + 1, pt(0)(2))), array(pt(0), pt(1), pt(3)))
	tabMaker = arrOutput
End Function
Function labelEdge(curve, text)
	labelEdge = Null
	Dim arrOutput, pt
	pt = Rhino.CurveMidPoint(curve)
	arrOutput = Rhino.AddTextDot(text, pt)
	labelEdge = arrOutput
End Function
Function tileObject(arrObjects, spacing)
	tileObject = Null
	Dim arrOutput(), arrVal()
	ReDim arrOutput(ubound(arrObjects)), arrVal(ubound(arrObjects(0)))
	Dim i,s
	Dim bBox, pt()
	ReDim pt(ubound(arrObjects))
	s = 0
	For i = 0 To uBound(arrObjects) Step 1
		bBox = Rhino.BoundingBox(arrObjects(i))
		If i > 0 Then
			arrOutput(i) = Rhino.MoveObjects(arrObjects(i), bBox(0), pt(i - 1))
		Else
			arrOutput(i) = Rhino.MoveObjects(arrObjects(i), bBox(0), bBox(0))
		End If
		bBox = Rhino.BoundingBox(arrObjects(i))
		pt(i) = array(bBox(1)(0) + spacing, bBox(1)(1), bBox(1)(2))
	Next
	
	tileObject = arrOutput
End Function
Function triangulate(surface, cols, rows)
	triangulate = Null
	Dim arrOutput(), arrVal(), tVal(3), iStep, jStep
	ReDim arrOutput(rows-1), arrVal(cols*2-1)
	Dim i,j,r
	
	iStep = Rhino.SurfaceDomain(surface, 0)(1) / rows
	jStep = Rhino.SurfaceDomain(surface, 1)(1) / cols
	
	For i = 0 To rows - 1 Step 1
		r = 0
		For j = 0 To cols - 1 Step 1
			tval(0) = Rhino.EvaluateSurface(surface, array(iStep * i, jStep * (j + 1)))
			tval(1) = Rhino.EvaluateSurface(surface, array(iStep * (i + 1), jStep * j))
			tval(2) = Rhino.EvaluateSurface(surface, array(iStep * i, jStep * j))
			tval(3) = tval(0)
			
			arrVal(r) = tval
			
			tval(0) = Rhino.EvaluateSurface(surface, array(iStep * (i + 1), jStep * j))
			tval(1) = Rhino.EvaluateSurface(surface, array(iStep * i, jStep * (j + 1)))
			tval(2) = Rhino.EvaluateSurface(surface, array(iStep * (i + 1), jStep * (j + 1)))
			tval(3) = tval(0)
			arrVal(r + 1) = tval

			r = r + 2
		Next
		arrOutput(i) = arrVal
	Next
	
	triangulate = arrOutput
End Function
Function reparameterize(strCurveID)
	If Rhino.IsCurve(strCurveID) = True Then
		Call rhino.SelectObject(strCurveID)
		Call rhino.Command("reparameterize 0 1")
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strCurveID) = True Then
		Call rhino.SelectObject(strCurveID)
		Call rhino.Command("reparameterize 0 1 0 1")
		Call rhino.UnselectAllObjects()
	End If
End Function