Surface Six Pack

This script produces six options for surface subdivision within Rhino. It provides a curve set as an output which can be used for module population.

Rhino Script

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Wednesday, November 14, 2007 3:26:27 AM


Call Main()
Sub Main()
	'Inputs 
	Dim Surface, Cols, Rows, amplitudeD, amplitudeE
	'loops
	Dim i,o
	'returns
	
	Surface = Rhino.GetObject("Select Surface", 8)
	If isNull(Surface) Then Exit Sub
	Call reparameterize(Surface)
	
	Dim selection, gridset
	
	selection = Rhino.GetString("Select Grid Method", "Hexagon", array("Rectangle", "Diamond", "Hexagon", "TriangleA", "TriangleB", "X"))
	
	Cols = 10 'Rhino.GetReal("Cols",10,1)
	If isNull(Cols) Then Exit Sub
	Rows = 10 'Rhino.GetReal("Rows",10,1)
	If isNull(Rows) Then Exit Sub
	
	Call Rhino.EnableRedraw(False)
	If selection = "Rectangle" Then
		gridset = rectGrid(surface, cols, rows)
		
	ElseIf selection = "Diamond" Then
		gridset = diaGrid(surface, cols, rows)
		
	ElseIf selection = "TriangleA" Then
		gridset = TriangleGridA(surface, cols, rows)
		
	ElseIf selection = "TriangleB" Then
		gridset = TriangleGridB(surface, cols, rows)
		
	ElseIf selection = "X" Then
		gridset = XGrid(surface, cols, rows)
		
	ElseIf selection = "Hexagon" Then
		gridset = HexGrid(surface, cols, rows)
		
	End If
	
	'gridset variables now contain a two dimensional array of curves which can be used to populate units
	
	Call Rhino.EnableRedraw(True)
End Sub
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 HexGrid(surface, cols, rows)
	HexGrid = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	Dim origin(), originSet(),ptA(6)
	Dim curves(),curveSet()
	ReDim curves(rows),curveSet(cols)
	ReDim origin(rows)
	
	uDom = Rhino.SurfaceDomain(surface, 0)
	vDom = Rhino.SurfaceDomain(surface, 1)
	uStep = uDom(1) / cols
	vStep = vDom(1) / rows
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows Step 1
			
			If abs(j) Mod 2	Then
				origin(j) = Rhino.EvaluateSurface(surface, array(uStep * i, vStep * j))
				ptA(0) = Rhino.EvaluateSurface(surface, array(uStep * i + uStep / 3, vStep * j))
				ptA(1) = Rhino.EvaluateSurface(surface, array(uStep * i + uStep / 6, vStep * j + vStep))
				ptA(2) = Rhino.EvaluateSurface(surface, array(uStep * i - uStep / 6, vStep * j + vStep))
				ptA(3) = Rhino.EvaluateSurface(surface, array(uStep * i - uStep / 3, vStep * j))
				ptA(4) = Rhino.EvaluateSurface(surface, array(uStep * i - uStep / 6, vStep * j - vStep))
				ptA(5) = Rhino.EvaluateSurface(surface, array(uStep * i + uStep / 6, vStep * j - vStep))
				ptA(6) = ptA(0)
				curves(j) = Rhino.AddPolyline(ptA)
			Else
				If j > 0 And j < rows Then
					origin(j) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i, vStep * j))
					ptA(0) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i + uStep / 3, vStep * j))
					ptA(1) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i + uStep / 6, vStep * j + vStep))
					ptA(2) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i - uStep / 6, vStep * j + vStep))
					ptA(3) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i - uStep / 3, vStep * j))
					ptA(4) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i - uStep / 6, vStep * j - vStep))
					ptA(5) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i + uStep / 6, vStep * j - vStep))
					ptA(6) = ptA(0)
					curves(j) = Rhino.AddPolyline(ptA)
				End If
			End If
		Next
	curveSet(i) = curves
	Next
	
	HexGrid = curveSet
End Function
Function TriangleGridA(surface, cols, rows)
	TriangleGridA = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	Dim origins, points(), pointset()
	ReDim points(rows), pointset(cols)
	uDom = Rhino.SurfaceDomain(surface, 0)
	vDom = Rhino.SurfaceDomain(surface, 1)
	uStep = uDom(1) / cols
	vStep = vDom(1) / rows
	
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			If abs(j) Mod 2	Then
				points(j) = Rhino.EvaluateSurface(surface, array(uStep * .5+i * uStep, j * vStep))
				'Call Rhino.AddPoint(points(j))
			Else
				points(j) = Rhino.EvaluateSurface(surface, array(i * uStep, j * vStep))
				'Call Rhino.AddPoint(points(j))
			End If
		Next
	pointset(i) = points
	Next
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			If j < rows Then 
				If abs(j) Mod 2	Then
					If i < cols Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(i + 1)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(0)(j), pointset(i)(j)))
					End If
				Else
					If i = 0Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(cols)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(i - 1)(j), pointset(i)(j)))
					End If
				End If		
			End If
			If j > 0 Then 
				If abs(j) Mod 2	Then
					If i < cols Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(i + 1)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(0)(j), pointset(i)(j)))
					End If
				Else
					If i = 0Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(cols)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(i - 1)(j), pointset(i)(j)))
					End If
				End If		
			End If
			
		Next
	Next	
	TriangleGridA = array(origins, points)
End Function
Function TriangleGridB(surface, cols, rows)
	TriangleGridB = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	Dim origins, points(), pointset()
	ReDim points(rows), pointset(cols)
	uDom = Rhino.SurfaceDomain(surface, 0)
	vDom = Rhino.SurfaceDomain(surface, 1)
	uStep = uDom(1) / cols
	vStep = vDom(1) / rows
	
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			If abs(j) Mod 2	Then
				points(j) = Rhino.EvaluateSurface(surface, array(uStep * .5+i * uStep, j * vStep))
				'Call Rhino.AddPoint(points(j))
			Else
				points(j) = Rhino.EvaluateSurface(surface, array(i * uStep, j * vStep))
				'Call Rhino.AddPoint(points(j))
			End If
		Next
	pointset(i) = points
	Next
	
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			If j < rows Then 
				If abs(j) Mod 2	Then
					If i = 0 Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(cols)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(i - 1)(j), pointset(i)(j)))
					End If
				
				Else
					If i < cols Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(i + 1)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j + 1),, pointset(0)(j), pointset(i)(j)))
					End If

				End If		
			End If
			
			If j > 0 Then 
				If abs(j) Mod 2	Then
					If i = 0 Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(cols)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(i - 1)(j), pointset(i)(j)))
					End If
				
				Else
					If i < cols Then
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(i + 1)(j), pointset(i)(j)))
					Else
						Call Rhino.AddPolyline(array(pointset(i)(j), pointset(i)(j - 1),, pointset(0)(j), pointset(i)(j)))
					End If

				End If		
			End If
			
		Next
	Next	
	TriangleGridB = array(origins, points)
End Function
Function rectGrid(surface, cols, rows)
	rectGrid = Null
	Dim i,j,dblUdom, dblVdom, dblUstep, dblVstep
	Dim pt(4),crv(),crvSet()
	ReDim crv(cols),crvSet(rows)
		
	dblUdom = Rhino.SurfaceDomain(surface, 0)
	dblVdom = Rhino.SurfaceDomain(surface, 1)
	dblUstep = dblUdom(1) / (cols)
	dblVstep = dblVdom(1) / (rows)
	
	For i =	0 To cols - 1 Step 1
		For j = 0 To rows - 1 Step 1
			
			pt(0) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep - dblUstep * .5, dblVstep * .5+j * dblVstep - dblVstep * .5))
			pt(1) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep - dblUstep * .5, dblVstep * .5+j * dblVstep + dblVstep * .5))
			pt(2) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep + dblUstep * .5, dblVstep * .5+j * dblVstep + dblVstep * .5))
			pt(3) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep + dblUstep * .5, dblVstep * .5+j * dblVstep - dblVstep * .5))
			pt(4) = pt(0)
			
			crv(j) = Rhino.AddPolyline(pt)			
		Next
	crvSet(i) = crv
	Next		
	rectGrid = array(crvSet)
End Function
Function diaGrid(surface, cols, rows)
	diaGrid = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	Dim origin(), originSet(),ptA(4)
	Dim curves(),curveSet()
	ReDim curves(rows),curveSet(cols)
	ReDim origin(rows)
	
	uDom = Rhino.SurfaceDomain(surface, 0)
	vDom = Rhino.SurfaceDomain(surface, 1)
	uStep = uDom(1) / cols
	vStep = vDom(1) / rows
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows Step 1
			
			If abs(j) Mod 2	Then
				origin(j) = Rhino.EvaluateSurface(surface, array(uStep * i, vStep * j))
				ptA(0) = Rhino.EvaluateSurface(surface, array(uStep * i, vStep * j - vStep))
				ptA(1) = Rhino.EvaluateSurface(surface, array(uStep * i - uStep * .5, vStep * j))
				ptA(2) = Rhino.EvaluateSurface(surface, array(uStep * i, vStep * j + vStep))
				ptA(3) = Rhino.EvaluateSurface(surface, array(uStep * i + uStep * .5, vStep * j))
				ptA(4) = ptA(0)
				curves(j) = Rhino.AddPolyline(ptA)
			Else
				If j > 0 And j < rows Then
					origin(j) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i, vStep * j))
					ptA(0) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i, vStep * j - vStep))
					ptA(1) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i - uStep * .5, vStep * j))
					ptA(2) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i, vStep * j + vStep))
					ptA(3) = Rhino.EvaluateSurface(surface, array(uStep * .5+uStep * i + uStep * .5, vStep * j))
					ptA(4) = ptA(0)
					curves(j) = Rhino.AddPolyline(ptA)
				End If
			End If
		Next
	curveSet(i) = curves
	Next	
	diaGrid = array(curveSet)
End Function
Function XGrid(surface, cols, rows)
	XGrid = Null
	Dim i,j,dblUdom, dblVdom, dblUstep, dblVstep
	Dim pt(4),crvA(),crvSetA(),crvB(),crvSetB()
	ReDim crvA(rows),crvSetA(cols),crvB(rows),crvSetB(cols)
		
	dblUdom = Rhino.SurfaceDomain(surface, 0)
	dblVdom = Rhino.SurfaceDomain(surface, 1)
	dblUstep = dblUdom(1) / (cols)
	dblVstep = dblVdom(1) / (rows)
	
	For i =	0 To cols - 1 Step 1
		For j = 0 To rows - 1 Step 1
			
			pt(0) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep - dblUstep * .5, dblVstep * .5+j * dblVstep - dblVstep * .5))
			pt(1) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep - dblUstep * .5, dblVstep * .5+j * dblVstep + dblVstep * .5))
			pt(2) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep + dblUstep * .5, dblVstep * .5+j * dblVstep + dblVstep * .5))
			pt(3) = Rhino.EvaluateSurface(surface, array(dblUstep * .5+i * dblUstep + dblUstep * .5, dblVstep * .5+j * dblVstep - dblVstep * .5))
			
			crvA(j) = Rhino.AddLine(pt(0), pt(2))	
			crvB(j) = Rhino.AddLine(pt(1), pt(3))	
		Next
	crvSetA(i) = crvA
	crvSetB(i) = crvB
	Next		
	XGrid = array(crvSetA, crvSetB)
End Function