💻 Rhino 5
🔼 Rhino Script
🛠️ Visual Basic
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.
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
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