This simple triangulation fabrication script evaluates a surface and creates a tiled set of triangulated pieces with incrementally numbered tabs. To assemble, simply combine tabs with matching numbers… and your done.
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
triangles = triangulate(surface, cols, rows)
cuts = reOrient(triangles)
tile = tileObjects(cuts, spac + dept)
tri = drawTriangle(triangles)
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
Else
r = r + 1
t = i
End If
tabs = tabmaker(tile(i)(j)(0), dept, CStr(i & "." & "0." & r))
Call labelEdge(tri(i)(j)(0), CStr(i & "." & "0." & r))
tabs = tabmaker(tile(i)(j)(1), dept, CStr(i & "." & "1." & s))
Call labelEdge(tri(i)(j)(1), CStr(i & "." & "1." & s))
tabs = tabmaker(tile(i)(j)(2), dept, CStr("2." & i & "." & r))
Call labelEdge(tri(i)(j)(2), CStr("2." & t & "." & r))
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.ObjectColor(crv(k), RGB(255, 0, 0))
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 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 tileObjects(arrObjects, spacing)
tileObjects = Null
Dim arrOutput(), arrVal()
ReDim arrOutput(ubound(arrObjects)), arrVal(ubound(arrObjects(0)))
Dim i,j,r,s
Dim bBox, xDis(), yDis(), maxVal
ReDim xDis(ubound(arrObjects(0))),yDis(ubound(arrObjects(0)))
r = 0
For i = 0 To uBound(arrObjects) Step 1
r = r + maxVal + spacing
s = 0
For j = 0 To uBound(arrObjects(i)) Step 1
bBox = Rhino.BoundingBox(arrObjects(i)(j))
xDis(j) = Rhino.Distance(bBox(0), bBox(1))
yDis(j) = Rhino.Distance(bBox(0), bBox(3))
If j > 0 Then
s = s + yDis(j - 1) + spacing
End If
arrVal(j) = Rhino.MoveObjects(arrObjects(i)(j), array(0, 0, 0), array(r, s, 0))
Next
maxVal = Rhino.Max(xDis)
arrOutput(i) = arrVal
Next
tileObjects = 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