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." & i & "." & r)) Call labelEdge(tri(i)(j)(2), CStr("2." & t & "." & 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 Functionsurface, 0)(1) vDom = Rhino.SurfaceDomain(surface, 1)(1) For i = 0 To cols Step 1 For j = 0 To rows Step 1 ptsX(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, array((uDom / cols) * i, (vDom / rows) * j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface, array((uDom / cols) * i, (vDom / rows) * j))), scale)) ptsX(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, array((uDom / cols) * i, (vDom / rows) * j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorReverse(Rhino.SurfaceNormal(surface, array((uDom / cols) * i, (vDom / rows) * j)))), scale)) pts(j) = ptsX Next pt(i) = pts Next Dim a,b Dim inverse(),inv(),pointSetA(),pointSetB() ReDim inverse(rows),inv(cols),pointSetA(rows),pointSetB(cols) Dim arrBln(), blnSt ReDim arrBln(cols) u = 0 t = rhythmA(0) For i = 0 To cols Step 1 If u Mod (2) Then v = 0 Else v = 1 End If r = rhythmB(0) For j = 0 To rows Step 1 If v Mod (2) Then a = 0: b = 1 Else a = 1: b = 0 End If r = r - 1 If r = 0 Then r = rhythmB(s) v = v + 1 End If If s > uBound(rhythmB)Then v = 0 End If pointSetA(j) = pt(i)(j)(a) inverse(j) = b Next t = t - 1 If t = 0 Then t = rhythmA(u) u = u + 1 End If If u > uBound(rhythmA)Then u = 0 End If inv(i) = inverse blnSt = False r = 0 For j = 0 To rows Step 1 r = r + inverse(j) Next If r = 0 Or r = rows - 1 Then Else Call Rhino.addcurve(pointSetA, 3) End If Next For i = 0 To rows Step 1 r = 0 For j = 0 To cols Step 1 r = r + inv(j)(i) Next For j = 0 To cols Step 1 pointSetB(j) = pt(j)(i)(inv(j)(i)) Next If r = 0 Or r = cols - 1 Then Else Call Rhino.addcurve(pointSetB, 3) End If Next 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