This script allows the user to morph between surfaces at a given instance.
Rhino Script
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