This Rhino Script triangulates a surface with three pattern options
Pattern Types:
[A][A] | [A][B] | [A][B]
[A][A] | [A][B] | [B][A]
typ.0 _typ.1 _typ.2
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.
| platform: Rhino Script |
| function: Fabrication |
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'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 arrValue, cols, rows, spacing, height, typ
typ = Rhino.GetInteger("Select Triangulation Type",0,0,2)
If isNull(typ) Then Exit Sub
arrValue = Rhino.PropertyListBox(array("Columns","Rows","Tile Spacing","tabHeight"),array(10,10,1,0.5))
If isNull(arrValue) Then Exit Sub
cols = CDbl(arrValue(0))
rows = CDbl(arrValue(1))
spacing = CDbl(arrValue(2))
height = CDbl(arrValue(3))
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))
If i < 2 Then
outline(i) = flatten(tri(i),True)
Else
outline(i) = flatten(tri(i),False)
End If
Next
sort = sortTriangles(outline,typ)
surf = sortTriangles(tri,typ)
edge = drawTriangle(sort)
Call tileObjects(edge,spacing+height)
Dim blnDir
For i = 0 To uBound(edge) Step 1
r=0
s=0
For j = 0 To uBound(edge(i)) Step 1
If j Mod(2) Then: s=s+1: t=i : Else: r=r+1: t=i+1: End If
If typ = 0 Then
blnDir = False
Else
If r Mod(2) Then
If typ = 2 And i Mod(2) Then: blnDir = True: Else: blnDir = False: End If
Else
If typ = 2 And i Mod(2) Then: blnDir = False: Else: blnDir = True: End If
End If
End If
Call tabMaker(edge(i)(j)(0),height,i & "." & r & "." & 0,blnDir)
Call tabMaker(edge(i)(j)(1),height,i & "." & t & "." & 1,blnDir)
Call tabMaker(edge(i)(j)(2),height,i & "." & s & "." & 2,blnDir)
Call Rhino.addsrfpt(surf(i)(j))
Next
Next
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,blnUp)
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)))
If blnUp = True Then
Call Rhino.RotateObjects(temp,array(0,0,0),180,Rhino.WorldXYPlane()(2),False)
End If
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
Call Rhino.ObjectColor(lines,RGB(255,0,0))
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,blnDirection)
tabMaker = Null
Dim arrOutput, tPlane, pt(3), txt
tPlane = Rhino.ViewCPlane()
Call Rhino.ViewCPlane(,Rhino.WorldXYPlane())
pt(0) = Rhino.CurveMidPoint(curve)
If blnDirection = True Then
pt(1) = Rhino.CurveStartPoint(curve)
pt(2) = Rhino.CurveEndPoint(curve)
Else
pt(2) = Rhino.CurveStartPoint(curve)
pt(1) = Rhino.CurveEndPoint(curve)
End If
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



