Surface Tweening

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

---

This script allows the user to morph between surfaces at a given instance.

---

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Thursday, March 06, 2008 10:48:20 AM
 
Call Main()
Sub Main()
    Dim surfaces,iterations,ctrlCrv
    surfaces = Rhino.GetObjects("Select Surfaces to Morph", 8)
    If isNull(surfaces) Then Exit Sub
    iterations = Rhino.GetReal("Number of Objects Between Steps", 5, 1)
    If isNull(iterations) Then Exit Sub
    ctrlCrv = Rhino.GetBoolean("Display Control Curves", array("curveStatus", "delete", "display"), array(False))
     
    Call Rhino.EnableRedraw(False)
    Call surfaceMorpher(surfaces, iterations, ctrlCrv(0))
    Call Rhino.EnableRedraw(True)
     
End Sub
Function surfaceMorpher(surfaces, instances, crvBln)
    surfaceMorpher = Null
    Dim i,j,k,r,m
    Dim Ucount,Vcount,Udom,Vdom,objCount,pCount,pDom
    Dim arrU(),arrV(),domU(),domV()
    Dim tempPtSet
    Dim srfPts(),srfPtSet(),arrSrfPts(),ctrlCrvPts()
    objCount = uBound(surfaces)
    ReDim arrU(objCount), arrV(objCount),domU(objCount),domV(objCount)
    'Find out existing surface parameters
    For i = 0 To objCount Step 1
        pCount = Rhino.SurfacePointCount(surfaces(i))
        pDom = Rhino.SurfaceDegree(surfaces(i))
        arrU(i) = pCount(0)
        arrV(i) = pCount(1)
        domU(i) = pDom(0)
        domV(i) = pDom(1)
        'Call Rhino.Print(arrU(i))
        'Call Rhino.Print(arrV(i))
    Next
    'find you maximum values
    Dim surfRe
    Udom = Rhino.Max(domU)
    Vdom = Rhino.Max(domV)
    Ucount = Rhino.Max(arrU)
    Vcount = Rhino.Max(arrV)
     
    ReDim srfPts(Vcount),srfPtSet(Ucount),arrSrfPts(objCount)
    'rebuild the surfaces based on max values
    For i = 0 To objCount Step 1
        surfRe = Rhino.RebuildSurface(surfaces(i), array(Udom, Vdom), array(Ucount, Vcount))
    Next
    'extract the surface control points
    For i = 0 To objCount Step 1
        tempPtSet = Rhino.SurfacePoints(surfaces(i))
        m = 0 
        For j = 0 To Ucount - 1 Step 1
            For k = 0 To Vcount - 1 Step 1
                srfPts(k) = tempPtSet(m)
                m = m + 1
            Next
            srfPtSet(j) = srfPts
        Next
        arrSrfPts(i) = srfPtSet
    Next
    'resequence and create blend points
    ReDim ctrlCrvPts(objCount)
 
    Dim ctrlCrv,crvDom,crvSteps
    Dim finSrfPt(),finSrfSet(),arrFinSrfPts()
    crvSteps = instances * objCount + objCount
    ReDim finSrfSet(Vcount), arrFinSrfPts(Ucount),finSrfPt(crvSteps)
    r = 0
    For i = 0 To Ucount - 1 Step 1
        For j = 0 To Vcount - 1 Step 1
            For k = 0 To objCount Step 1
                ctrlCrvPts(k) = arrSrfPts(k)(i)(j)
            Next
            ctrlCrv = Rhino.AddInterpCurve(ctrlCrvPts)
            crvDom = Rhino.CurveDomain(ctrlCrv)
            For r = 0 To crvSteps Step 1
                finSrfPt(r) = Rhino.EvaluateCurve(ctrlCrv, r * (crvDom(1) / crvSteps))
            Next
            If crvBln = False Then
                Call Rhino.DeleteObject(ctrlCrv)
            End If
            finSrfSet(j) = finSrfPt
        Next
        arrFinSrfPts(i) = finSrfSet
    Next
     
    'resequence into point grid for surface
    Dim SrfCtrlPts(),endSurf()
    ReDim SrfCtrlPts(Vcount*Ucount-1),endSurf(crvSteps)
    For i = 0 To crvSteps Step 1
        r = 0
        For j = 0 To Ucount - 1 Step 1
            For k = 0 To Vcount - 1 Step 1
                SrfCtrlPts(r) = arrFinSrfPts(j)(k)(i)
                r = r + 1
            Next
        Next
        endSurf(i) = Rhino.AddSrfControlPtGrid(array(Ucount, Vcount), SrfCtrlPts, array(Udom, Vdom))
    Next
    Call Rhino.DeleteObjects(surfaces)
    surfaceMorpher = endSurf
End Function

---