RhinoScript – Octree Subdivision

 
Option Explicit
' Script written by www.supermanoeuvre.com

Call Main()
 
Sub Main()
 
	'----------------------------------------------------------------------------
	' USER INPUTS
	Dim arrRectanglePts : arrRectanglePts = rhino.GetPoints(vbTrue , vbTrue , "Define a rectangle: First corner" , "Define a rectangle: Other corner" , 2)
	If isNull(arrRectanglePts) Then rhino.print "You did not define a rectangle"
	If isNull(arrRectanglePts) Then Exit Sub
 
	Dim strCrvs : strCrvs = rhino.GetObjects("Gimme Curve to process octTree divisions", 4)
	If isNull(strCrvs) Then rhino.print "You did not define a rectangle"
	If isNull(strCrvs) Then Exit Sub
 
	Dim intCrvSampling : intCrvSampling = rhino.GetInteger("What max sampling of the lattice structure to inform subDivision???", 5, 2, 20)
	If isNull(intCrvSampling) Then Exit Sub
 
	Dim intMaxGenerations : intMaxGenerations = rhino.GetInteger("Maximum number of generations???", 8, 2, 20)
	If isNull(intMaxGenerations) Then Exit Sub
 
	Dim arrPtsSubD : arrPtsSubD = buildPts(strCrvs, intCrvSampling)	
	rhino.print "Number of points = " & ubound(arrPtsSubD)+1
 
 
 
	'----------------------------------------------------------------------------
	' SCRIPT BODY
	rhino.print "SCRIPT STARTED!!!"
	rhino.enableRedraw False
 
	Dim strStartQuad()
 
 
	ReDim Preserve strStartQuad(0)
	strStartQuad(0) = add_2D_Rectangle(arrRectanglePts(0), arrRectanglePts(1))
 
	' First Generation
	Call recursiveQuadDivision(strStartQuad, arrPtsSubD, 1, intMaxGenerations)		
 
	rhino.enableRedraw True
	rhino.print "SCRIPT COMPLETED!!!"
 
End Sub
 
Function recursiveQuadDivision(STRQUADS, PTS, GEN, MAXGENS)
 
	recursiveQuadDivision = Null	
 
	If GEN < MAXGENS Then
 
		'-------------------------------------------------------------------------------------		
		Dim i,j,k, counter		
		Dim intTest, blnInside
 
		Dim arrQuadsCurrent
		ReDim arrQuadsNext(-1), arrQuads2Delete(-1)
 
		arrQuadsCurrent = STRQUADS
 
		counter = 0
 
		For i = 0 To ubound(arrQuadsCurrent)
			' Reset boolean switch
			intTest = 0
			blnInside = False
 
			' Check if point is inside current quad
			For j = 0 To ubound(PTS)
				intTest = rhino.PointInPlanarClosedCurve( PTS(j), arrQuadsCurrent(i) )
				If intTest = 1 Then
					blnInside = True				
				End If
			Next
 
			'------------------------------------------------------------------------------
			' If point is inside then subdivide current quad
			If blnInside = True Then
				Dim arrPtsCnrs : arrPtsCnrs = Rhino.CurveEditPoints( arrQuadsCurrent(i) )
				Dim arrPtCntr  : arrPtCntr  = Rhino.CurveAreaCentroid( arrQuadsCurrent(i) ) 
 
				For k = 0 To ubound(arrPtsCnrs)-1
					ReDim Preserve arrQuadsNext(counter), arrQuads2Delete(counter)
					arrQuadsNext(counter)    = add_2D_Rectangle(arrPtsCnrs(k), arrPtCntr(0))
					arrQuads2Delete(counter) = arrQuadsCurrent(i)
					counter = counter + 1					
				Next				
			End If		
 
		Next
 
		Call killQuads(arrQuads2Delete)
 
		'-----------------------------------------------------------------------------
		' Recursion function
		If ubound(arrQuadsNext) = -1 Then
			Exit Function				
		Else
			Call recursiveQuadDivision(arrQuadsNext, PTS, GEN+1, MAXGENS)		
		End If	
 
	Else		
		Exit Function		
	End If
 
 
	recursiveQuadDivision = arrQuadsNext
 
End Function
 
'--------------------------------------------------------------------
' 2D Division Function
Function add_2D_Rectangle(PT0, PT2)
 
	add_2D_Rectangle = Null
 
	Dim arrPoints(4)
	arrPoints(0) = PT0  
	arrPoints(1) = Array( PT2(0), PT0(1), PT0(2) ) 
	arrPoints(2) = PT2
	arrPoints(3) = Array( PT0(0), PT2(1), PT0(2) )
	arrPoints(4) = PT0
 
	If IsArray(arrPoints) Then
		add_2D_Rectangle = Rhino.addPolyline (arrPoints)	
	End If
 
End Function
 
'--------------------------------------------------------------------
' Builds array of points from starting curves
Function BuildPts(CRVS, DIVS)
 
	BuildPts = Null
 
	Dim i, j	
	Dim arrPts()
 
	Dim counter : counter = 0
 
	For i = 0 To ubound(CRVS)
 
		Dim arrPtsDiv : arrPtsDiv = Rhino.DivideCurve (CRVS(i), DIVS)
 
		For j = 0 To ubound(arrPtsDiv)
			ReDim Preserve arrPts(counter)
			arrPts(counter) = arrPtsDiv(j)
			counter = counter + 1
		Next
 
	Next	
 
	BuildPts = arrPts
 
End Function
 
'--------------------------------------------------------------------
' Deletes any superceded quads
Function killQuads(ARR)	
 
	killQuads = Null
 
	Dim i	
 
	For i = 0 To ubound(ARR)
		rhino.DeleteObject(ARR(i))		
	Next
 
End Function