Recursive surface panelization

From KokkugiaWiki

recursive surface panelisation
this is an example of how to generate surface panels that vary in scale and colour to best approximate the curvature of an existing surface. We do this by recursive subdivision. This script is an extension of the simpler script on Generating surface panels.

In this example the previous script is put into a function and recursively called. Each time we create a new surface panel, we analyze its mean curvature. for surfaces that have a lot of curvature we continue to subdivide the panels into smaller panels. the surfaces are also coloured based on their mean curvature. this could be useful for fabrication purposes where a material specifies a maximum change in curvature per panel as a constraint, or if we wish to build this script to generate only flat panels - in this case we use more smaller panels to better approximate the original curvature of the surface. we could also constrain the panels to only developable surfaces by using the gaussian curvature rather than mean curvature for our analysis although this introduces other considerations that we do not cover here.

Option Explicit
'------------------------------------------------------------------------------
' recursively subdivide surface based on curvature
' author: robert stuart-smith | 2008 | www.kokkugia.com

Call Main()
Sub Main()

	Dim strSrf
	
	'get surface
	strSrf = Rhino.GetObject("pick a surface",8)
	
	Rhino.EnableRedraw False
	
	'call function to subdivide
	PanelizeSurface strSrf, 10,5
	
	Rhino.EnableRedraw True
End Sub

Function 	PanelizeSurface(strSrf, intSubD,intGen)	
	'declare variables
	Dim arrCrvs, arrCrvPts, arrPara
	Dim i,j,n, arrCrvsU, arrCrvsV, arrSrfs()
	
	'conditional statement to stop subdividing infinitely 
	'(as we will Call the Function recursively)
	If intGen > 0 Then	
		'resize arrays for storing curves in both directions of surface; u & v directions
		ReDim arrCrvsU(intSubD)
		ReDim arrCrvsV(intSubD)	
		
		'extract edge curves
		arrCrvs = Rhino.DuplicateEdgeCurves(strSrf)
		
		'do for 2 curves one in both directions of surface:
		For i = 0 To 1
			'divide curveby number of points (using variable subD)
			arrCrvPts = Rhino.DivideCurve(arrCrvs(i), intSubD, False,True)		
			For j = 0 To Ubound(arrCrvPts)
				'extract isocurves using points in the array above
				arrPara = Rhino.SurfaceClosestPoint(strSrf, arrCrvPts(j))
				'use case statement to seperate isocurves into their direction (u or v) and store in u or v array
				Select Case i
					Case 0
						arrCrvsU(j) = Rhino.ExtractIsoCurve(strSrf, arrPara,1)
					Case 1
						arrCrvsV(j) = Rhino.ExtractIsoCurve(strSrf, arrPara, 0)
				End Select		
			Next
		Next
		'loop through curves to create surfaces
		n = 0
		For i = 0 To Ubound(arrCrvsU) -1
			For j = 0 To Ubound(arrCrvsV) -1
				ReDim Preserve arrSrf(n)
				arrSrf(n) = Rhino.AddEdgeSrf(Array(arrCrvsU(i)(0),arrCrvsV(j)(0), arrCrvsU(i+1)(0),arrCrvsV(j+1)(0)))
				n = n + 1		
			Next
		Next
		
		'delete the original surface
		Rhino.DeleteObject strSrf
		
		
		Dim arrPt, arrCurvature,dblMCurvature
		
		'loop through created panels
		For i = 0 To Ubound(arrSrf)
			'get surface centre point
			arrPt = Rhino.SurfaceAreaCentroid(arrSrf(i))
			'get surface parameter at the ctr point
			arrPara = Rhino.SurfaceClosestPoint(arrSrf(i),arrPt(0))
			'get the surface curvature at the surface parameter position
			arrCurvature = Rhino.SurfaceCurvature(arrSrf(i),arrPara)
			'size up and simplify curvature result for legibility
			dblMCurvature = abs(arrCurvature(7)*1000)
			'colour surface based on mean curvature
			Rhino.ObjectColor arrSrf(i), RGB(dblMCurvature*2, 0, dblMCurvature) 

			'based on curvature choose to subdivide further or not  - ie. recursively call this function
			If 50 < dblMCurvature Then
				PanelizeSurface arrSrf(i), 2, intGen -1
			End If			
		Next		
	End If
	
End Function