Triangulate 3 Pack

💻 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

---