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