Weave A

 

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Saturday, October 04, 2008 7:52:05 PM

Call Main()
Sub Main()
    Dim surface, weave, arrItems, arrValues, arrResults
   
    surface = Rhino.GetObject("Select Surface",8)
    If isNull(surface) Then Exit Sub
    Call reparameterize(surface)
   
    arrItems = array("Warp Strands","Weft Strands","Depth")
    arrValues = array(10,10,0.5)
    arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Weave Settings")
    If isNull(arrResults) Then Exit Sub
   
    Call Rhino.EnableRedraw(False)
    weave = crossWeave(surface,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)))
    Call Rhino.EnableRedraw(True)
   
End Sub
Function crossWeave(surface,cols,rows,depth)
    crossWeave = Null
    cols = cols*2
    rows = rows*2
    Dim i, j, r, s, count, uDom, vDom, origin, srfNorm,crvCount
    crvCount = cols*0.5+rows*0.5-1
    Dim boolVal(), blnVal(), normal(1),norm(),nrm(),crvs(),xcrvs()
    ReDim boolVal(rows), blnVal(cols)
    ReDim norm(rows),nrm(cols),crvs(crvCount),xcrvs(crvCount)
    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
            boolVal(j) = array(0,1)
            origin = array(uDom/(cols)*i,vDom/(rows)*j)
            srfNorm = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,origin)),depth)
           
            normal(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),srfNorm)
            normal(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),Rhino.VectorReverse(srfNorm))
            norm(j) = normal
           
        Next
        blnVal(i) = boolVal
        nrm(i) = norm
    Next
   
    Dim ptA(),ptB(),ptC(),ptD()
    If cols>rows Then
        count = cols
    Else
        count = rows
    End If
   
    s=0
    For i = 1 To count Step 1
        r=0
        ReDim ptA(0), ptB(0)
        If i Mod(2) Then
            If cols > rows Then
                If i < rows Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r+1)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    r=0
                    For j = 0 To rows-i Step 1
                        ReDim Preserve ptB(r)
                        blnVal(cols-rows+i+j)(rows-j) = flipMe(r)
                        ptB(r) = nrm(cols-rows+i+j)(rows-j)(blnVal(cols-rows+i+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
                    s=s+1
                Else
                    For j = 0 To rows Step 1
                        ReDim Preserve ptA(r)
                        blnVal(i-rows+j)(rows-j) = flipMe(r)
                        ptA(r) = nrm(i-rows+j)(rows-j)(blnVal(i-rows+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    s=s+1
                End If
            ElseIf rows > cols Then
                If i < cols Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    r=0
                    For j = 0 To cols-i Step 1
                        ReDim Preserve ptB(r)
                        blnVal(i+j)(rows-j) = flipMe(r+1)
                        ptB(r) = nrm(i+j)(rows-j)(blnVal(i+j)(rows-j)(0))
                        r=r+1
                    Next
                    crvs(rows*0.5+s) = Rhino.AddInterpCurve(ptB)
                    s=s+1
                Else
                    For j = 0 To cols Step 1
                        ReDim Preserve ptA(r)
                        blnVal(j)(i-j) = flipMe(r)
                        ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                        r=r+1
                    Next
                    crvs(s) = Rhino.AddInterpCurve(ptA)
                    s=s+1
                End If
            Else
                'If they are equal
                For j = 0 To i Step 1
                    ReDim Preserve ptA(r)
                    blnVal(j)(i-j) = flipMe(r)
                    ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
                    r=r+1
                Next
                r=0
                For j = 0 To cols-i Step 1
                    ReDim Preserve  ptB(r)
                    blnVal(i+j)(cols-j) = flipMe(r+1)
                    ptB(r) = nrm(i+j)(cols-j)(blnVal(i+j)(cols-j)(0))
                    r=r+1
                Next
                crvs(s) = Rhino.AddInterpCurve(ptA)
                crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
                s=s+1
            End If
        End If
    Next
   
    s=0
    For i = 1 To count Step 1
        r=0
        ReDim ptC(0), ptD(0)
        If i Mod(2) Then
            If cols > rows Then
                If i < rows Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptC(r), ptD(r)
                        ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                        ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptD)
                    s=s+1
                    xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
                Else
                    r=0
                    For j = 0 To rows Step 1
                        ReDim Preserve ptC(r)
                        ptC(r) = nrm(i-rows+j)(j)(blnVal(i-rows+j)(j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptC)
                    s=s+1
                End If
            ElseIf rows > cols Then
                If i < cols Then
                    For j = 0 To i Step 1
                        ReDim Preserve ptC(r), ptD(r)
                        ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                        ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                        r=r+1
                    Next
                    xcrvs(s) = Rhino.AddInterpCurve(ptD)
                    s=s+1
                    xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
                Else
                    r=0
                    For j = 0 To cols Step 1
                        ReDim Preserve ptC(r)
                        ptC(r) = nrm(j)(i-cols+j)(blnVal(j)(i-cols+j)(1))
                        r=r+1
                    Next
                    s=s+1
                    xcrvs(rows*0.5+cols*0.5-s) = Rhino.AddInterpCurve(ptC)
                End If
            Else
                For j = 0 To i Step 1
                    ReDim Preserve ptC(r),ptD(r)
                    ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
                    ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
                    r=r+1
                Next
                xcrvs(cols-1-s) = Rhino.AddInterpCurve(ptC)
                xcrvs(s) = Rhino.AddInterpCurve(ptD)
                s=s+1
            End If
        End If
    Next
   
    crossWeave = array()
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
Function flipMe(input)
    flipMe = Null
    Dim output(1)
    If input Mod(2) Then
        output(0) = 0
        output(1) = 1
    Else
        output(0) = 1
        output(1) = 0
    End If
    flipMe = output
End Function