top of page
Writer's pictureDavid Mans

Weave B

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

 

This Rhino Script uses a series of curves, warp, and weft, running parallel to the UV directions of a surface, weaving two disparate series of integers as rules for the over/under pattern.

 
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Friday, September 12, 2008 6:05:11 PM
 
Call Main()
Sub Main()
    Dim surface, arrItems, arrValues, arrResults, rhythmA,rhythmB
    surface = Rhino.GetObject("Select Surface", 8)
    If isNull(surface) Then Exit Sub
     
    arrItems = array("Warp Strands", "Weft Strands", "Depth", "Warp Rhythm(up,down...)", "Warp Rhythm(up,down...)")
    arrValues = array(10, 10, 1, "2,3,2", "2,3,2")
    arrResults = Rhino.PropertyListBox(arrItems, arrValues,, "Weave Settings")
     
    rhythmA = split(arrResults(3), ",")
    rhythmB = split(arrResults(4), ",")
     
    Call Rhino.EnableRedraw(False)
    Call reparameterize(surface)
    Call weave(surface, CDbl(arrResults(0)), CDbl(arrResults(1)), CDbl(arrResults(2)), rhythmA, rhythmB)
    Call Rhino.EnableRedraw(True)
     
     
End Sub
Function weave(surface, cols, rows, scale, rhythmA, rhythmB)
    weave = Null
     
    Dim i,j,r,s,t,u,v
    Dim uDom, vDom
    Dim pts(), ptsX(1), pt()
    ReDim pts(rows),pt(cols)
     
    uDom = Rhino.SurfaceDomain(surface, 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
 


4 views

Recent Posts

See All

Comments


bottom of page