This Rhino Script triangulates a surface with three pattern options
Pattern Types: [A][A] | [A][B] | [A][B] [A][A] | [A][B] | [B][A]
This version of the script lays out the resulting triangular faces in a tiled grid with numbered tabs which allow for rapid reconstruction. To assemble simply match up tab numbers.
Rhino Script
Option Explicit 'Script written by <insert name> 'Script copyrighted by <insert company name> 'Script version Monday, March 23, 2009 11:03:52 AM Call Main() Sub Main() Dim surface surface = Rhino.GetObject("Select Surface", 8, True) If isnull(surface) Then Exit Sub Dim cols, rows, spacing, height, typ cols = 10 rows = 10 spacing = 1 height = 0.5 typ = 0 Dim i,j,k,r,s,t Dim arrVals Dim grid,sort,edge,surf,tri(3),outline(3) Call Rhino.EnableRedraw(False) grid = arrEvalSrf(surface, cols, rows) arrVals = array(array(0, 0, 1, 1, 1, 0), array(1, 1, 0, 0, 0, 1), array(1, 0, 0, 1, 0, 0), array(0, 1, 1, 0, 1, 1)) For i = 0 To 3 Step 1 tri(i) = triangulate(surface, grid, arrVals(i)) outline(i) = flatten(tri(i)) Next sort = sortTriangles(outline, typ) surf = sortTriangles(tri, typ) edge = drawTriangle(sort) Call tileObjects(edge, spacing + height) For i = 0 To uBound(edge) Step 1 r = 0 s = 0 For j = 0 To uBound(edge(i)) Step 1 Call Rhino.addsrfpt(surf(i)(j)) Next Next Call Rhino.HideObject(surface) Call Rhino.EnableRedraw(True) End Sub Function arrEvalSrf(surface, cols, rows) arrEvalSrf = Null Dim i,j Dim pt(), arrOutput(), dom(1), stp(1) ReDim pt(rows), arrOutput(cols) dom(0) = Rhino.SurfaceDomain(surface, 0) dom(1) = Rhino.SurfaceDomain(surface, 1) stp(0) = (dom(0)(1) - dom(0)(0)) / cols stp(1) = (dom(1)(1) - dom(1)(0)) / rows For i = 0 To cols Step 1 For j = 0 To rows Step 1 pt(j) = Rhino.EvaluateSurface(surface, array(dom(0)(0) + stp(0) * i, dom(1)(0) + stp(1) * j)) Next arrOutput(i) = pt Next arrEvalSrf = arrOutput End Function Function triangulate(surface, arrPoints, arrValues) triangulate = Null Dim i,j,k,r, cols, rows Dim pts(), arrOutput(), pt(3), maxVal(1) maxVal(0) = Rhino.Max(array(arrValues(0), arrValues(2), arrValues(4))) maxVal(1) = Rhino.Max(array(arrValues(1), arrValues(3), arrValues(5))) cols = ubound(arrPoints) - maxVal(0) ReDim arrOutput(cols) For i = 0 To cols Step 1 rows = ubound(arrPoints(i)) - maxVal(1) ReDim pts(rows) For j = 0 To rows Step 1 r = 0 For k = 0 To 2 Step 1 pt(k) = arrPoints(i + arrValues(r))(j + arrValues(r + 1)) r = r + 2 Next pt(3) = pt(0) pts(j) = pt 'Call Rhino.AddPolyline(pts(j)) Next arrOutput(i) = pts Next triangulate = arrOutput End Function Function flatten(arrPoints) flatten = Null Dim i,j,k, cols, rows Dim pts(), arrOutput(), tPts(3), pt(3), temp cols = uBound(arrPoints) ReDim arrOutput(cols) For i = 0 To cols Step 1 rows = ubound(arrPoints(i)) ReDim pts(rows) For j = 0 To rows Step 1 For k = 0 To 3 Step 1 tPts(k) = Rhino.AddPoint(arrPoints(i)(j)(k)) Next temp = Rhino.OrientObjects(tPts, 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))) For k = 0 To 3 Step 1 Pt(k) = Rhino.PointCoordinates(temp(k)) Call Rhino.DeleteObject(temp(k)) Next pts(j) = pt Next arrOutput(i) = pts Next flatten = arrOutput End Function Function drawTriangle(arrPoints) drawTriangle = Null Dim i,j,k, cols, rows Dim arrTemp(), arrOutput(),lines(2) cols = uBound(arrPoints) ReDim arrOutput(cols) For i = 0 To cols Step 1 rows = ubound(arrPoints(i)) ReDim arrTemp(rows) For j = 0 To rows Step 1 For k = 0 To 2 Step 1 lines(k) = Rhino.AddLine(arrPoints(i)(j)(k), arrPoints(i)(j)(k + 1)) Next arrTemp(j) = lines Next arrOutput(i) = arrTemp Next drawTriangle = arrOutput End Function Function sortTriangles(arrSet, blnType) sortTriangles = Null Dim i,j,k,r,a,b, cols, rows Dim arrTemp(), arrOutput() cols = uBound(arrSet(0)) ReDim arrOutput(cols) For i = 0 To cols Step 1 rows = ubound(arrSet(0)(i)) r = 1 For j = 0 To rows Step 1 If blnType = 0 Then a = array(1, 1) ElseIf blnType = 1 Then a = array(1, 2) ElseIf blnType = 2 Then a = array(2, 2) End If If i Mod (a(0)) Then If j Mod (a(1)) Then b = array(0, 1) Else b = array(2, 3) End If Else If j Mod (a(1)) Then b = array(2, 3) Else b = array(0, 1) End If End If ReDim Preserve arrTemp(r) arrTemp(r - 1) = arrSet(b(0))(i)(j) arrTemp(r) = arrSet(b(1))(i)(j) r = r + 2 Next arrOutput(i) = arrTemp Next sortTriangles = arrOutput End Function Function tileObjects(arrObjects, spacing) tileObjects = Null Dim i,j,cols,rows,arrOutput(),arrTemp() Dim origin, tDis, dist, bBox() origin = array(0, 0, 0) cols = uBound(arrObjects) ReDim arrOutput(cols) For i = 0 To cols Step 1 rows = uBound(arrObjects(i)) ReDim bBox(rows),arrTemp(rows) tDis = 0 For j = 0 To rows Step 1 bBox(j) = Rhino.BoundingBox(arrObjects(i)(j)) dist = Rhino.Distance(bBox(j)(0), bBox(j)(1)) If j = 0 Then Call Rhino.MoveObjects(arrObjects(i)(j), bBox(j)(0), origin) Else Call Rhino.MoveObjects(arrObjects(i)(j), bBox(j)(0), bBox(j - 1)(3)) Call Rhino.MoveObjects(arrObjects(i)(j), array(0, 0, 0), array(0, spacing, 0)) End If bBox(j) = Rhino.BoundingBox(arrObjects(i)(j)) If tDis < dist Then tDis = dist origin = array(bBox(j)(1)(0) + spacing, 0, 0) End If arrTemp(j) = arrObjects(i)(j) Next arrOutput(i) = arrTemp Next tileObjects = arrOutput End Function Function tabMaker(curve, depth, text) tabMaker = Null Dim arrOutput, tPlane, pt(3), txt tPlane = Rhino.ViewCPlane() Call Rhino.ViewCPlane(, Rhino.WorldXYPlane()) 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))) Call Rhino.ViewCPlane(, tPlane) tabMaker = arrOutput End Function