top of page

Triangulate Strips

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

 

This simple triangulation fabrication script takes a single surface and evaluates it at a user-specified density. The script then creates a flattened set of strip templates for printing/ laser cutting which are numbered for easy assembly.

 
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, strip
    triangles = triangulate(surface, cols, rows)
    cuts = reOrient(triangles)
    tri = drawTriangle(triangles)
    strip = makeStrips(cuts)
    tile = tileObject(strip, spac + dept)
     
     
    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
                If j > 0 Then
                    Call Rhino.DeleteObject(cuts(i)(j)(0))
                End If
                If j < ubound(triangles(i)) Then
                    Call Rhino.ObjectColor(cuts(i)(j)(1), RGB(255, 0, 0))
                End If
            Else
                r = r + 1
                t = i
                If j > 0 Then
                    Call Rhino.DeleteObject(cuts(i)(j)(1))
                End If
                Call Rhino.ObjectColor(cuts(i)(j)(0), RGB(255, 0, 0))
            End If
             
            tabs = tabmaker(cuts(i)(j)(2), dept, CStr("2." &amp; i &amp; "." &amp; r))
            Call labelEdge(tri(i)(j)(2), CStr("2." &amp; t &amp; "." &amp; r))
            Call Rhino.ObjectColor(cuts(i)(j)(2), RGB(255, 0, 0))
            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.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 makeStrips(arrObjects)
    makeStrips = Null
    Dim arrOutput(), arrVal()
    ReDim arrOutput(ubound(arrObjects))
    Dim i,j,k,r
    Dim ptA(2), ptB(2)
    For i = 0 To ubound(arrObjects) Step 1
        r = 0
        ReDim arrVal(r)
        For j = 0 To ubound(arrObjects(i)) - 1 Step 1
            If j Mod (2) Then
                ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j + 1)(1))
                ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j + 1)(1))
                ptA(2) = array(ptA(0)(0), ptA(0)(1), ptA(0)(2) + 1)
             
                ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(1))
                ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(1))
                ptB(2) = array(ptB(0)(0), ptB(0)(1), ptB(0)(2) + 1)
            Else
                ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j + 1)(0))
                ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j + 1)(0))
                ptA(2) = array(ptA(0)(0), ptA(0)(1), ptA(0)(2) + 1)
             
                ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(0))
                ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(0))
                ptB(2) = array(ptB(0)(0), ptB(0)(1), ptB(0)(2) + 1)
            End If
             
            Call Rhino.OrientObjects(arrObjects(i)(j + 1), ptA, ptB)
            If j = 0 Then
                For k = 0 To ubound(arrObjects(i)(j)) Step 1
                    ReDim Preserve arrVal(r)
                    arrVal(r) = arrObjects(i)(j)(k)
                    r = r + 1
                Next
            End If
            For k = 0 To ubound(arrObjects(i)(j + 1)) Step 1
                ReDim Preserve arrVal(r)
                arrVal(r) = arrObjects(i)(j + 1)(k)
                r = r + 1
            Next
        Next
        arrOutput(i) = arrVal
    Next
    makeStrips = 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 tileObject(arrObjects, spacing)
    tileObject = Null
    Dim arrOutput(), arrVal()
    ReDim arrOutput(ubound(arrObjects)), arrVal(ubound(arrObjects(0)))
    Dim i,s
    Dim bBox, pt()
    ReDim pt(ubound(arrObjects))
    s = 0
    For i = 0 To uBound(arrObjects) Step 1
        bBox = Rhino.BoundingBox(arrObjects(i))
        If i > 0 Then
            arrOutput(i) = Rhino.MoveObjects(arrObjects(i), bBox(0), pt(i - 1))
        Else
            arrOutput(i) = Rhino.MoveObjects(arrObjects(i), bBox(0), bBox(0))
        End If
        bBox = Rhino.BoundingBox(arrObjects(i))
        pt(i) = array(bBox(1)(0) + spacing, bBox(1)(1), bBox(1)(2))
    Next
     
    tileObject = 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 Functionsurface, 0)(1)
    vDom = Rhino.SurfaceDomain(surface, 1)(1)
    For i = 0 To cols Step 1
        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
 


3 views

Recent Posts

See All
bottom of page