GEODEX 2.0

The relaunch of GEODEX includes a complete overhaul of the component structure.

- All functions now use range inputs for evaulating the curve functions allowing the user to sample the curves at any specific points.

- All equations have been reworked and repaired, fixing several errors and cleaning up the input structure.

- New polar equations have been added.

Developed to coordinate renderings with presentations put together using Adobe products, the following function allows for the conversion of Adobe ASE swatch library files to Grasshopper RGB and CMYK values which can be plugged into the appropriate grasshopper color functions.  Simply specify the filepath to an ASE file containing CMYK, RGB, or HEX values using the "File(Read File)" component, from which the function will return a lists of the corresponding C, M, Y and K values and R, G, and B values as defined in the ASE file.  Hex colors are converted to RGB internally, RGB values are set between 0-255, and CMYK are scaled from 0-100 to 0-1.0 as specified by the grasshopper component.  So far it has been tested with both custom color pallets created from illustrator and pallets downloaded from Kuler.

This function was developed as a quick fix, so this is most likely not the most optimal solution.  But it seems to work.

ASE-RGB_CMYK-GH .ghx (download)

*C,M,Y,K,R,G,B outputs are all still separated

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Wednesday, 16 February 2011 12:03:34

Call Main()
Sub Main()
	Dim strLayer 
	strLayer = Rhino.GetLayer("Select Layers To Match")
	If isNull(strLayer) Then Exit Sub
	
	Call Rhino.EnableRedraw(False)
	Dim intMat, ingColor
	intMat = Rhino.LayerMaterialIndex(strLayer)
	ingColor = Rhino.LayerColor(strLayer)
	If intMat < 0 Then
		intMat = Rhino.AddMaterialToLayer(strLayer)
	End If
	Call Rhino.MaterialColor(intMat,ingColor)
	Call Rhino.EnableRedraw(True)
End Sub

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic.net>
'Script version Sunday, August 22, 2010 12:09:23 AM

Call Main()
Sub Main()
 Dim arrObjects, counts
 arrObjects = Rhino.GetObjects("Select Objects",,,True)
 If isNull(arrObjects) Then Exit Sub

 counts = Rhino.GetInteger("Number of Sets")
 If isNull(counts) Then Exit Sub

 Dim i, j

 Call Rhino.EnableRedraw(False)

 For i = 0 To counts-1 Step 1
  Call Rhino.AddGroup("Group_" & i)
 Next

 For i = 0 To uBound(arrObjects) Step 1
  j = CInt(rnd()*(counts-1))
  Call Rhino.AddObjectToGroup(arrObjects(i),CStr("Group_" & j))
 Next

 Call Rhino.EnableRedraw(True)

End Sub

These vb Components for Grasshopper, adapted from work by Damian Alamar of www.liquidtectonics.com, allows for the streaming in and out of data from Excel to Grasshopper with parametric control of not only data placement but also general formatting.  The functions are broken up into 5 individual components, an import column reader, an export column writer, and three formatting functions for type, cell, and border.  These components are designed to operate on a per column basis allowing the user to create sheets in a flexible format.  To stream information to or from excel, simply open an empty excel workbook and switch the _Stream input to a boolean value of true.  Data will be actively updated as parameters change.  The "Write to Excel" function allows the user to specify a title for the column, the column to stream to and the starting row.  Additionally three optional inputs for the formatting options can be applied, but are not required.  The final inputs are the list of data and the and a boolean to toggle streaming on and off.  The three formatting inputs work off of the basic available formatting options for a cell in excel, for the border this is style, thickness, and color, for the cell this is the pattern, the pattern color and the fill color, and for the text the inputs are, height, color, horizontal justification, vertical justification, bold, italic, underline, strikethrough, subscript, superscript.  Formatting options are available on the MSDN, msdn.microsoft.com, database.  The "Read Excel" function allows for the input of data from a specific column in excel to a list in grasshopper.  The inputs allow the user to specify the start column and row as well as an optional limit on the number of cells to be read in the column.  If this is left empty the data will be read down to the last value in the column.

Excel.ghx (download)

This vb Component for Grasshopper is a simple stripped down tool that takes an analysis from Ecotect and extracts the relevant information into numerical values which can be read by Grasshopper. It begins by taking the data output in csv format from a Solar Access Analysis interprets the output files format into its component parts, center point, surface normal, and returned value.  Additionally the data type, "type of analysis" is output as text as well as the units used for the value set.  The data, if properly coordinated can then be used to program any associated geometry.  The input is simply a filepath function pointed towards the output csv file.  A sample csv file has been attached.

ecotect.ghx (download)

This vb Component for Grasshopper produces three standard triangulation types of regular meshing.  Developed for the production of consistent meshes for analysis in Autodesk Ecotect, the three components produce a sequenced grid of domain outputs for a re-parametrized surface and the corresdponding face vertex ID's to produce consistent triangular meshing, 

triangulateMesh.ghx (download)

This vb Component for Grasshopper takes a series of values and evaluated them relative to a user specified set of minimum and maximum vales returning a user specified value for that range.  If a value falls below the lowest min it takes the corresponding minimum output value as producing the same relationship for a value which exceeds the maximum.

roundtorange.ghx (download)

This vb Component for Grasshopper takes a series of values and locates and indexes common values.  Returning each a corresponding list of the unique values and their total number of repetitions.  Developed for fabrication this function is useful for optimizing production.

types.ghx (download)

THIS FUNCTION HAS BEEN MADE OBSOLETE BY THE "REMAP" FUNCTION

This vb Component for Grasshopper takes a series of points and finds the minimum and maximum x and y values and uses them to calculate the unitized position of each point relative to a range of 0-1 in the x and y axis.

unitizePoints.ghx (download)

This vb Component for Grasshopper takes three non linear points and evaluates their triangular incenter, returning both the point and the inscribed circle radius of the triangle. 

triangleIncenter.ghx (download)

This vb Component for Grasshopper takes three edge length and produces the corresponding triangle.  This particular function begins with the first edge being aligned to the x axis of the world top in Rhino and produces the geometry so long as the three input numbers are valid to create a triangle.

triangleByEdgeLength.ghx (download)

This vb Component for Grasshopper takes three point inputs and calculates their triangular area as well as the perimeter of the combined triangular edges.  Developed for mesh like surfaces this function allows for rapid collection of surface area of a faceted form. 

triangleArea.ghx (download)

This vb Component for Grasshopper takes a list of numerical values and evaluated them relative to a floor and ceiling value.  If the value exceeds or goes below the user specified values the resulting values is changed to the specified limit value.

threshold.ghx (download)

This vb Component for Grasshopper simply takes a series of points and sorts them from a user specified starting point by finding the next closest point incrementally till it moves through the entire list.  Its primary function is rebuilding curves from extracted point sets. 

closestPoint.ghx (download)

This vb Component for Grasshopper simplifies the boolean interface to a simple two in one out relationship.  The user simply specifies plugs in an input for true and sets the type, and next plugs in a input for false and specifies its type, then simply plugs in a true or false values and gets the defined return. 

boolean.ghx (download)

This vb Component for Grasshopper allows the user to convert between real world units, ex. inches to centimeters, picas to sun, take your pick.  The components interface has three inputs, a numerical input, where a double value can be input, a string input which specifies the type of unit being input, and  a string input which specifies the type of unit being output.  The result is the conversion of one units value to another.  The conversion works by taking the input unit and converting it to centimeters as a normal, then multiplies it against the conversion ratio for the specified output unit.  Because of grasshoppers constraints some extremely low ratios will appear as 0.  The unit converter supports the following units of measurement, both archaic and common:angstrom, bu, cable, centimeter, chain, chi, cho, cun, decimeter, fathom, fen, foot, furlong, hand, hao, hu, inch, jyo, kabiet, kairi, ken, keub, kilometer, league, li, line, link, meter, micrometre, mil, mile, millimeter, mon, nieu, nonometer, perch, pica, pixel, point, ri, rod, sawk, seaLeague, seaMile, sen, shortCable, shyaku, si, sun, surveyFoot, twip, wah, yard, yin, yote ,zhang.  Ratio's were determined through www.onlineconversion.com and www.convert-me.com .  Distances conversions have been tested 3 times but should be confirmed for accuracy before being used.  Please notify immediately if there is an error in ratio.

unitConverter.ghx (download)

This vb Component for Grasshopper allows the user to enhance the functionality of the standard slider.  The component allows the user to specify a minimum and maximum domain for the range of the slider to move through.  The user can also specify an increment by which the output can step by.  The final input is a slider which should be scaled from 0-1 for the component to work properly, though it will work with additional values.  If the user does not specify a "high" value, the slider will simply scale to the "increment" value, if the "high" and the "increment" values are not specified then the value will simply scale with the "sliders" input.  If "low" is left blank the series will begin at 0. Finally, if the user leaves the "increment" value blank the component will simply scale between the "low" and "high" values as the sliders default increment.

advancedSlider.ghx (download)

 

THIS FUNCTION HAS BEEN MADE OBSOLETE BY THE "REMAP" COMPONENT

This vb Component for Grasshopper takes a list of numbers in any sequence and proportionally unitizes the values from 0 to 1.  The user simply inputs the list of values and the component outputs a corresponding set of unitized values.

unitizeValues.ghx (download)

 

THIS FUNCTION HAS BEEN MADE OBSOLETE BY THE "FLIP MATRIX" COMPONENT

This vb Component for Grasshopper allows the user to quickly resort a ordered 2d array of points across the array.  If the default is reading the list row by row, it reads it column by column. Since Grasshopper reads the typical point list as a continuous 1d array, the selection of a modulus value is required as a second input in addition to the initial point list.  The resultant output is a reordered 1d list of points.

reSequencePointGrid.ghx (download)

 

This grasshopper file takes a series of vectors and mimics the default grasshopper aesthetic with a conic and cylindrical polysurface which can be baked for rendering or used for data colorization etc.  The visualization takes in a vector, an origin point and a length, and applies to this a scale relative to the proportion of the radial "arrow". 

---

MaterializeVector.ghx (download)

 

 

These grasshopper functions takes a list of points and outputs a list of corresponding points which are either Next or Previous in the initial sequence.  The function has two inputs, 1. the initial list of points, 2: a boolean which determines whether the point sequence should treat the points a an open ended sequence or a closed loop, creating "tangent" like relationships.  

ex. if your geometry is circular and you want the sequence to assume continuity, you would choose true, if it was a line and you simply want it to end you would choose false.

---

NextPoint.ghx (download)

PrevPoint.ghx (download)

 

 

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Sunday, March 28, 2010 5:08:39 PM

Call Main()
Sub Main()
	Dim strSurface, arrInputs
	strSurface = Rhino.GetObject("Select Surface to Rain From",8,True)
	If isNull(strSurface) Then Exit Sub

	arrInputs = Rhino.PropertyListBox(array("Sources","Stream Radius","Droplets","Rate 0-1","Splash Radius","Stream Angle Radius"),array(50,0.1,10,0.5,0.5,4),"Rain Parameters","Rain Parameters")
	If isNull(arrInputs) Then Exit Sub

	Call reparameterize(strSurface)
	Call Rhino.EnableRedraw(False)
	Call rainMaker(strSurface,arrInputs(0),arrInputs(1),arrInputs(2),arrInputs(3),arrInputs(4),arrInputs(5))
	Call Rhino.EnableRedraw(True)

End Sub
Function rainMaker(strSurface,dblCount,dblDispersion,dblDensity,dblRate,dblSplash, dblVarience)
	rainMaker = Null
	Dim i, j, k, a, w, v, s, t, u, z, clr, var
	Dim srfDom(1),srfD(1),srfA(1),srfR(1),srfS(1),srfE(1),pt(1), r(1)
	Dim ln(), spl(), temp(3)

	For i = 0 To 1 Step 1
		srfDom(i) = Rhino.surfacedomain(strSurface,i)
		srfD(i) = (srfDom(i)(1)-srfDom(i)(0))
		srfA(i) = srfD(i)-srfD(i)*dblDispersion
		srfR(i) = srfD(i)*(dblDispersion/2)
		srfS(i) = srfDom(i)(0)+srfD(i)*(dblDispersion/2)
		srfE(i) = srfDom(i)(1)-srfD(i)*(dblDispersion/2)
	Next

	w = 0
	a = 0
	var = rnd()
	For i = 0 To dblCount Step 1
		u = srfS(0)+rnd()*srfA(0)
		v = srfS(1)+rnd()*srfA(1)
		r(0) = srfR(0)/2+rnd()*(srfR(0)/2)
		r(1) = srfR(1)/2+rnd()*(srfR(1)/2)
		clr = v/srfE(1)
		For j = 0 To dblDensity Step 1
			ReDim Preserve ln(w)
			pt(0) = Rhino.EvaluateSurface(strSurface,array(u+rnd()*r(0),v+rnd()*r(1)))
			pt(1) = array(pt(0)(0)+dblVarience*sin(PI*2*var),pt(0)(1)+dblVarience*cos(PI*2*var),0)
			t = 1-rnd()*dblRate
			ln(w) = Rhino.ScaleObject(Rhino.AddLine(pt(0),pt(1)),pt(0),array(t,t,t),False)
			pt(1) = Rhino.CurveEndPoint(ln(w))

			Call Rhino.ObjectColor(ln(w),RGB(clr*255,clr*255,clr*255))

			If pt(1)(2) < 0.1 Then
				ReDim Preserve spl(a)
				For k = 0 To 3 Step 1
					t = rnd()
					temp(k) = Rhino.AddLine(pt(1),array(pt(1)(0)+dblSplash*sin(PI*2*t),pt(1)(1)+dblSplash*cos(PI*2*t),pt(1)(2)+dblSplash*sin(PI*t)))
					Call Rhino.ObjectColor(temp(k),RGB(clr*255,clr*255,clr*255))
				Next
				spl(a) = temp
				a=a+1
			End If
			w=w+1
		Next
	Next

	rainMaker = array(ln,spl)
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, November 02, 2008 1:18:47 PM

Call Main()
Sub Main()
	Dim objects, segment
	objects = Rhino.GetObjects("Select Points, Curves, and Surfaces",,,True)
	If isNull(objects) Then Exit Sub

	segment = Rhino.GetBoolean("DeleteSegments",array("CurveSegments","No","Yes","SurfaceSegments","No","Yes"),array(True,True))
	If isNull(segment) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Dim i,r,s,t, pts(), crvs(), srfs(), crvOutput, srfOutput
	ReDim pts(0), crvs(0), srfs(0)

	r=0:s=0:t=0
	For i = 0 To uBound(objects) Step 1
		If Rhino.IsPoint(objects(i)) = True Then
			ReDim Preserve pts(r)
			pts(r) = objects(i)
			r=r+1
		ElseIf Rhino.IsCurve(objects(i)) = True Then
			ReDim Preserve crvs(s)
			crvs(s) = objects(i)
			s=s+1
		ElseIf Rhino.IsSurface(objects(i)) = True Then
			ReDim Preserve srfs(t)
			srfs(t) = objects(i)
			t=t+1
		End If

	Next
	If uBound(pts) > 0 Then
		Call overKillPoints(pts)
	End If
	If uBound(crvs) > 0 Then
		crvOutput = overKillCurves(crvs)
		If segment(0) = True Then
			Call partialCrvOverlap(crvOutput)
		End If
	End If
	If uBound(srfs) > 0 Then
		srfOutput = overKillSurfaces(srfs)
		If segment(1) = True Then
			Call partialSrfOverlap(srfOutput)
		End If
	End If

	Call Rhino.EnableRedraw(True)

End Sub
Function overKillPoints(points)
	overKillPoints = Null
	Dim i,j,count, pts(), deleted()
	count = uBound(points)
	ReDim pts(count), deleted(count)
	For i = 0 To count Step 1
		pts(i) = Rhino.PointCoordinates(points(i))
		deleted(i) = False
	Next

	For i = 0 To count Step 1
		For j = 0 To count Step 1
			If j <> i Then
				If deleted(j) = False Then
					If pts(i)(0) = pts(j)(0) And pts(i)(1) = pts(j)(1) And pts(i)(2) = pts(j)(2) Then
						Call Rhino.DeleteObject(points(i))
						deleted(i) = True
					End If
				End If
			End If
		Next
	Next

End Function
Function overKillCurves(curves)
	overKillCurves = Null
	Dim i,j,k,m,r,count, pts(), blnVal, deleted()
	count = uBound(curves)
	ReDim pts(count), deleted(count)

	For i = 0 To count Step 1
		pts(i) = Rhino.CurvePoints(curves(i))
		deleted(i) = False
	Next
	blnVal = 0
	For i = 0 To count Step 1
		For j = 0 To count Step 1
			If j <> i Then
				If deleted(j) = False Then
					If Ubound(pts(i)) = uBound(pts(j)) Then
						For k = 0 To Ubound(pts(i)) Step 1
							m = Ubound(pts(i))-k
							If pts(i)(k)(0) = pts(j)(k)(0) And pts(i)(k)(1) = pts(j)(k)(1) And pts(i)(k)(2) = pts(j)(k)(2) Or pts(i)(k)(0) = pts(j)(m)(0) And pts(i)(k)(1) = pts(j)(m)(1) And pts(i)(k)(2) = pts(j)(m)(2) Then
								blnVal = blnVal+1
							End If
						Next

						If blnVal = uBound(pts(i))+1 Then
							deleted(i) = True
						End If
						blnVal = 0
					End If
				End If
			End If
		Next
	Next
	r=0
	Dim crvOutput()
	For i = 0 To count Step 1
		If deleted(i) = True Then
			Call Rhino.DeleteObject(curves(i))
		Else
			ReDim Preserve crvOutput(r)
			crvOutput(r) = curves(i)
			r = r+1
		End If
	Next
	overKillCurves = crvOutput
End Function
Function overKillSurfaces(surfaces)
	overKillSurfaces = Null
	Dim i,j,k,m,n,r,s,t,count, tCount, uvCnt
	Dim aPt(), bPt(), cPt(), dPt(), ePt(), fPt(), gPt(), hPt()
	Dim ptsA(), pts(), tPts(), sPts(), blnVal, deleted()
	count = uBound(surfaces)
	ReDim ptsA(count), pts(count), deleted(count)

	For i = 0 To count Step 1
		r = 0: s = 0
		ptsA(i) = Rhino.SurfacePoints(surfaces(i))
		uvCnt = Rhino.SurfacePointCount(surfaces(i))
		tCount = Ubound(ptsA(i))
		ReDim tPts(uvCnt(0)-1), sPts(uvCnt(1)-1)
		For j = 0 To tCount Step 1
			tPts(r) = ptsA(i)(tCount-j)

			r=r+1
			If r = uvCnt(0) Then
				r = 0
				sPts(s) = tPts
				s = s+1
			End If
		Next

		ReDim aPt(tCount), bPt(tCount), cPt(tCount), dPt(tCount), ePt(tCount), fPt(tCount), gPt(tCount), hPt(tCount)
		t = 0
		For j = 0 To uvCnt(0)-1 Step 1
			For k = 0 To uvCnt(1)-1 Step 1
				aPt(t) = sPts(j)(k)
				bPt(t) = sPts(uvCnt(0)-1-j)(uvCnt(1)-1-k)
				cPt(t) = sPts(j)(uvCnt(1)-1-k)
				dPt(t) = sPts(uvCnt(0)-1-j)(k)
				t=t+1
			Next
		Next
		t = 0
		For j = 0 To uvCnt(1)-1 Step 1
			For k = 0 To uvCnt(0)-1 Step 1
				ePt(t) = sPts(k)(j)
				fPt(t) = sPts(uvCnt(0)-1-k)(uvCnt(1)-1-j)
				gPt(t) = sPts(k)(uvCnt(1)-1-j)
				hPt(t) = sPts(uvCnt(0)-1-k)(j)
				t=t+1
			Next
		Next
		pts(i) = array(apt,bpt,cpt,dpt,ept,fpt,gpt,hpt)
		deleted(i) = False
	Next

	blnVal = 0
	For i = 0 To count Step 1
		For j = 0 To count Step 1
			If j <> i Then
				If deleted(j) = False Then
					If Ubound(pts(i)(0)) = uBound(pts(j)(0)) Then

						For m = 0 To 7 Step 1
							For n = 0 To 7 Step 1
								For k = 0 To Ubound(pts(i)(0)) Step 1

									If pts(i)(m)(k)(0) = pts(j)(n)(k)(0) And pts(i)(m)(k)(1) = pts(j)(n)(k)(1) And pts(i)(m)(k)(2) = pts(j)(n)(k)(2) Then
										blnVal = blnVal+1
									End If

								Next
							Next
						Next

						If blnVal >= uBound(pts(j)(0)) Then
							Call Rhino.DeleteObject(surfaces(i))
							deleted(i) = True
						End If
						blnVal = 0
					End If
				End If
			End If
		Next
	Next
	Dim srfOutput()
	r = 0
	For i = 0 To count Step 1
		If deleted(i) = True Then
			Call Rhino.DeleteObject(surfaces(i))
		Else
			ReDim Preserve srfOutput(r)
			srfOutput(r) = surfaces(i)
			r=r+1
		End If
	Next
	overKillSurfaces = srfOutput
End Function
Function partialCrvOverlap(crvs)
	partialCrvOverlap = Null

	Dim i, j, k, count, blnDelete(), dblOverlap

	count = uBound(crvs)
	dblOverlap = 0

	Dim crvPts()
	ReDim crvPts(count), blnDelete(count)

	For i = 0 To count Step 1
		crvPts(i) = Rhino.CurveEditPoints(crvs(i))
		blnDelete(i) = False
	Next

	For i = 0 To count Step 1
		For j = 0 To count Step 1
			If i <> j Then
				For k = 0 To uBound(crvPts(j)) Step 1
					If Rhino.IsPointOnCurve (crvs(i), crvPts(j)(k)) = True Then
						dblOverlap = dblOverlap+1
					End If
				Next
			End If
			If uBound(crvPts(j))+1 = dblOverlap Then
				blnDelete(j) = True
			End If
			dblOverlap = 0
		Next
	Next
	For i = 0 To count Step 1
		If blnDelete(i) = True Then
			Call Rhino.DeleteObject(crvs(i))
		End If
	Next

	partialCrvOverlap = array()
End Function
Function partialSrfOverlap(srfs)
	partialSrfOverlap = Null

	Dim i, j, k, count, blnDelete(), dblOverlap

	count = uBound(srfs)
	dblOverlap = 0

	Dim srfPts()
	ReDim srfPts(count), blnDelete(count)

	For i = 0 To count Step 1
		srfPts(i) = Rhino.SurfaceEditPoints (srfs(i))
		blnDelete(i) = False
	Next

	For i = 0 To count Step 1
		For j = 0 To count Step 1
			If i <> j Then
				For k = 0 To uBound(srfPts(j)) Step 1
					If Rhino.IsPointOnSurface (srfs(i), srfPts(j)(k)) = True Then
						dblOverlap = dblOverlap+1
					End If
				Next
			End If
			If uBound(srfPts(j))+1 = dblOverlap Then
				blnDelete(j) = True
			End If
			dblOverlap = 0
		Next
	Next
	For i = 0 To count Step 1
		If blnDelete(i) = True Then
			Call Rhino.DeleteObject(srfs(i))
		End If
	Next

	partialSrfOverlap = array()
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Tuesday, July 21, 2009 7:50:34 PM

Call Main()
Sub Main()
	Dim arrPoints,intSamples
	Do
		arrPoints = Rhino.GetObjects("Select at Least 3 Points",1,,True)
		If isNull(arrPoints) Then Exit Sub

		If uBound(arrPoints) > 1 Then
			Exit Do
		End If
	Loop
	intSamples = Rhino.GetReal("Samples",10,1)
	If isNull(intSamples) Then Exit Sub

	Dim i, arrPts(),arrOutput
	ReDim arrPts(uBound(arrPoints))
	For i = 0 To uBound(arrPoints) Step 1
		arrPts(i) = Rhino.PointCoordinates(arrPoints(i))
	Next

	Call Rhino.EnableRedraw(False)
	arrOutput = bezierConstructor(arrPts,intSamples)
	Call Rhino.AddInterpCurve(arrOutput(0))
	Call Rhino.ObjectColor(arrOutput(1),RGB(255,0,0))
	Call Rhino.EnableRedraw(True)

End Sub
Function bezierConstructor(arrPts,intSamples)
	bezierConstructor = Null
	Dim i, j, k, r, s, t
	Dim arrOutput(), arrOutputs(), arrStore, arrTemp, arrLines(),arrSet()
	r = 0
	k=1
	ReDim arrOutput(0),arrOutputs(0)
	arrOutput(0) = arrPts(0)

	For i = 1 To uBound(arrPts) Step 1
		ReDim Preserve arrLines(r),arrOutputs(r)
		arrLines(r) = Rhino.AddLine(arrPts(i-1),arrPts(i))
		arrOutputs(r) = arrLines(r)
		r=r+1
	Next
	t=r
	arrStore = arrLines
	For i = 1 To intSamples-1 Step 1
		r=0
		s=0
		arrTemp = arrStore
		Do
			If r = 1 Then
				ReDim Preserve arrOutput(k)
				arrOutput(k) = curveParameter(arrTemp(0),i*(1/intSamples))
				k=k+1
				Exit Do
			End If
			r=0
			ReDim Preserve arrSet(s)
			arrSet(s) = arrTemp
			ReDim arrLines(0)
			For j = 1 To ubound(arrSet(s)) Step 1
				ReDim Preserve arrLines(r), arrOutputs(t)
				arrLines(r) = Rhino.AddLine(curveParameter(arrSet(s)(j-1),i*(1/intSamples)),curveParameter(arrSet(s)(j),i*(1/intSamples)))
				arrOutputs(t) = arrLines(r)
				t=t+1
				r=r+1
			Next
			arrTemp = arrLines
			s=s+1
		Loop
	Next
	ReDim Preserve arrOutput(k)
	arrOutput(k) = arrPts(uBound(arrPts))
	bezierConstructor = array(arrOutput,arrOutputs)
End Function
Function curveParameter(strCurve,dblParameter)
	curveParameter = Null
	Dim cDom,arrPoint
	cDom = Rhino.CurveDomain(strCurve)
	arrPoint = Rhino.EvaluateCurve(strCurve,cDom(0)+dblParameter*(cDom(1)-cDom(0)))
	curveParameter = arrPoint
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Sunday, May 03, 2009 1:54:38 PM

Call Main()
Sub Main()
	Dim Curves, SM, DN

	Curves= Rhino.GetObjects("Select Curves",4)
	If isNull(Curves) Then Exit Sub

	SM = Rhino.GetBoolean("Blend Type",array("Type","Straight","Smooth"),array(False))
	If isNull(SM) Then Exit Sub

	DN = Rhino.GetReal("Blend Density",5,1)
	If isNull(SM) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	If uBound(Curves) > 0 Then
		Call BlendCurves(Curves,SM(0),DN)
	Else
		Call Rhino.Print("2 or more curves required")
	End If

	Call Rhino.EnableRedraw(True)
End Sub
Function BlendCurves(arrCurves,blnSmooth,dblDensity)
	BlendCurves = Null
	Dim i,j,p
	Dim count, max, dMax
	Dim arrptCount(), arrCrvDeg(), arrPointSet(),arrPts(), arrCrvDom(),arrCrvStep(),arrBlndCrvPt()
	Dim arrBlendCurve(), arrCtrlCrv()

	Dim dblSmoothness
	If blnSmooth = False Then
		dblSmoothness = 1
	Else
		dblSmoothness = 3
	End If

	count = Ubound(arrCurves)
	ReDim arrptCount(count),  arrCrvDeg(count), arrCrvDom(count), arrPointSet(count), arrPts(count)

	'get control point count
	For i = 0 To count Step 1
		arrptCount(i) = Rhino.CurvePointCount(arrCurves(i))
		arrCrvDeg(i) = Rhino.CurveDegree(arrCurves(i))
	Next
	'determine max point count
	max = Rhino.Max(arrptCount)
	dMax= Rhino.Max(arrCrvDeg)

	'rebuild curves with max control point count
	For i = 0 To count Step 1
		Call Rhino.RebuildCurve(arrCurves(i),dMax, max)
		arrPointSet(i) = Rhino.CurvePoints(arrCurves(i))
	Next

	max = max-1
	ReDim arrCtrlCrv(max), arrCrvDom(max), arrCrvStep(max), arrBlndCrvPt(max)
	'create control curves
	For i = 0 To max Step 1
		For j = 0 To count Step 1
			arrPts(j) = arrPointSet(j)(i)
		Next
		arrCtrlCrv(i)= Rhino.AddInterpCurve(arrPts,dblSmoothness)
		arrCrvDom(i) = Rhino.CurveDomain(arrCtrlCrv(i))
		arrCrvStep(i)= (arrCrvDom(i)(1)-arrCrvDom(i)(0))/(count*dblDensity)
	Next
	'create blended curves
	ReDim arrBlendCurve(count*dblDensity)
	For i = 0 To count*dblDensity Step 1
		For j = 0 To max Step 1
			arrBlndCrvPt(j) = Rhino.EvaluateCurve(arrCtrlCrv(j),arrCrvDom(j)(0)+i*arrCrvStep(j))
		Next
		arrBlendCurve(i) = Rhino.addcurve(arrBlndCrvPt,dMax)
	Next
	'delete control curves
	Call Rhino.DeleteObjects(arrCtrlCrv)
	Call Rhino.DeleteObjects(arrCurves)

	BlendCurves = array(arrBlendCurve,arrCtrlCrv)
End Function

'coming soon

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Monday, September 01, 2008 6:39:25 AM

Call Main()
Sub Main()
	Call connectTwoCurves()
End Sub
Function connectTwoCurves()
	connectTwoCurves = Null
	Dim curve(1)
	curve(0) = Rhino.GetObject("Select Curve 1",4)
	If isNull(curve(0)) Then Exit Function
	curve(1) = Rhino.GetObject("Select Curve 2",4)
	If isNull(curve(1)) Then Exit Function
	Call Rhino.EnableRedraw(False)
	Dim dir
	Dim ptA(1),ptB(1),dist(1),cap(1)
	ptA(0) = Rhino.CurveStartPoint(curve(0))
	ptA(1) = Rhino.CurveEndPoint(curve(0))
	ptB(0) = Rhino.CurveStartPoint(curve(1))
	ptB(1) = Rhino.CurveEndPoint(curve(1))
	dist(0)= Rhino.Distance(ptA(0),ptB(0))
	dist(1)= Rhino.Distance(ptA(0),ptB(1))

	If dist(0) = dist(1) Then
		dir = True
		cap(0) = Rhino.AddLine(ptA(0),ptB(0))
		cap(1) = Rhino.AddLine(ptA(1),ptB(1))
	Else
		If dist(0) < dist(1) Then
			dir = True
			cap(0) = Rhino.AddLine(ptA(0),ptB(0))
			cap(1) = Rhino.AddLine(ptA(1),ptB(1))
		Else
			dir = False
			cap(0) = Rhino.AddLine(ptA(0),ptB(1))
			cap(1) = Rhino.AddLine(ptA(1),ptB(0))
		End If
	End If
	Call Rhino.EnableRedraw(True)
	Dim arrResults,arrInputs,arrValues
	arrInputs = array("Flip","Yes","No","Type","Smooth","Straight","Join","Yes","No")
	arrValues = array(True,True,False)
	arrResults = Rhino.GetBoolean("Connection Options",arrInputs,arrValues)

	Call Rhino.EnableRedraw(False)
	Dim tan(3),blend, ptC(3)
	If arrResults(1) = False Then
		Call Rhino.DeleteObjects(cap)
		blend = 0.25
		tan(0) = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorReverse(Rhino.CurveTangent (curve(0), Rhino.CurveDomain(curve(0))(0)))),Rhino.Distance(ptA(0),ptA(1))*blend)
		tan(1) = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.CurveTangent (curve(0), Rhino.CurveDomain(curve(0))(1))),Rhino.Distance(ptA(0),ptA(1))*blend)
		tan(2) = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorReverse(Rhino.CurveTangent (curve(1), Rhino.CurveDomain(curve(1))(0)))),Rhino.Distance(ptB(0),ptB(1))*blend)
		tan(3) = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.CurveTangent (curve(1), Rhino.CurveDomain(curve(1))(1))),Rhino.Distance(ptB(0),ptB(1))*blend)

		ptC(0) = Rhino.PointAdd(Rhino.CurveStartPoint(curve(0)),tan(0))
		ptC(1) = Rhino.PointAdd(Rhino.CurveEndPoint(curve(0)),tan(1))
		ptC(2) = Rhino.PointAdd(Rhino.CurveStartPoint(curve(1)),tan(2))
		ptC(3) = Rhino.PointAdd(Rhino.CurveEndPoint(curve(1)),tan(3))
		If arrResults(0) = True Then
			If dir = False Then
				cap(0) = Rhino.AddCurve(array(ptA(0),ptC(0),ptC(3),ptB(1)),3)
				cap(0) = Rhino.AddCurve(array(ptA(1),ptC(1),ptC(2),ptB(0)),3)
			Else
				cap(0) = Rhino.AddCurve(array(ptA(0),ptC(0),ptC(2),ptB(0)),3)
				cap(0) = Rhino.AddCurve(array(ptA(1),ptC(1),ptC(3),ptB(1)),3)
			End If
		Else
			If dir = False Then
				cap(0) = Rhino.AddCurve(array(ptA(0),ptC(0),ptC(2),ptB(0)),3)
				cap(0) = Rhino.AddCurve(array(ptA(1),ptC(1),ptC(3),ptB(1)),3)
			Else
				cap(0) = Rhino.AddCurve(array(ptA(0),ptC(0),ptC(3),ptB(1)),3)
				cap(0) = Rhino.AddCurve(array(ptA(1),ptC(1),ptC(2),ptB(0)),3)
			End If

		End If
	Else
		If arrResults(0) = False Then
			Call Rhino.DeleteObjects(cap)
			If dir = False Then
				cap(0) = Rhino.AddLine(ptA(0),ptB(0))
				cap(1) = Rhino.AddLine(ptA(1),ptB(1))
			Else
				cap(0) = Rhino.AddLine(ptA(0),ptB(1))
				cap(1) = Rhino.AddLine(ptA(1),ptB(0))
			End If
		Else

		End If
	End If
	If arrResults(2) = False Then
		Call Rhino.JoinCurves(array(curve(0),cap(0),curve(1),cap(1)),True)
	End If
	Call Rhino.EnableRedraw(True)

	connectTwoCurves = array()
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Monday, April 27, 2009 9:56:55 PM

Call Main()
Sub Main()

	Dim arrCurves: arrCurves = Rhino.GetObjects("Select Curve",4,True)
	If isnull(arrCurves) Then Exit Sub

	Dim a, b, c, i
	Dim arrSet()

	a = Rhino.GetReal ("Parameter A.0 (0<x>1)" , 0, 0, 1)
	If isNull(a) Then Exit Sub
	Do
		If i > 0 Then
			c = Rhino.GetReal ("Parameter A." & i & " (" & a & "< x > 1)" , a, a, 1)
			If isNull(c) Or c = a Or c = 1 Then Exit Do
		Else
			c = a
		End If

		b = Rhino.GetReal ("Parameter B." & i & " (" & c & "< x > 1)" , c, c, 1)
		If isNull(b) Or b = c Or b = 1 Then Exit Do
		a = b

		ReDim Preserve arrSet(i)
		arrSet(i) = array(CDbl(c),CDbl(b))

		i = i+1
	Loop

	If b = 0 Then Exit Sub

	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(arrCurves) Step 1
		reparameterize(arrCurves(i))
		Call removeSegment(arrCurves(i),arrSet)
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function removeSegments(strCurve,arrParams)
	removeSegments = Null
	Dim arrOutput()
	Dim i, r, curve, crv, keep

	i = 0
	r = 0
	keep = strCurve
	Do
		curve = Rhino.SplitCurve(keep,arrParams(i)(0),True)
		If uBound(curve) = 0 Then
			crv = Rhino.SplitCurve(curve(0),arrParams(i)(1),True)
		Else
			crv = Rhino.SplitCurve(curve(1),arrParams(i)(1),True)
		End If
		Call Rhino.DeleteObject(crv(0))

		ReDim Preserve arrOutput(r)
		arrOutput(r) = curve(0)
		r = r+1

		If uBound(curve) = 0 Then
			If i = 0 Then
				r = 0
			Else
				Exit Do
			End If
		End If

		If i = uBound(arrParams) And uBound(crv) > 0 Then
			ReDim Preserve arrOutput(r)
			arrOutput(r) = crv(1)
		End If
		i = i+1
		If i = uBound(arrParams)+1 Then Exit Do
		keep = crv(1)
	Loop

	removeSegments = arrOutput
End Function
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

Option Explicit
'Script written by <David Mans (adapted from work by Che Wei Wang www.cwwang.com>
'Script copyrighted by <Neoarchaic Studio>
'Script version Sunday, September 28, 2008 12:18:06 AM

Call Main()
Sub Main()
	Dim objects, folder, name, arrResults, arrDrawings
	objects = Rhino.GetObjects("Select Objects")
	If isNull(objects) Then Exit Sub

	arrDrawings = Rhino.GetBoolean("DrawingTypes", array("orthoElev","no","yes","auxElev","no","yes","auxTop","no","yes","auxBottom","no","yes","isoTop","no","yes","isoBottom","no","yes"),array(True,False,False,False,False,True))

	arrResults = Rhino.GetBoolean("Output Options", array("drawings","no","yes","renders","no","yes"),array(True,False))

	If arrResults(1) = True Then
		name=Rhino.GetString("Enter prefix for jpeg file naming")
		folder = Rhino.BrowseForFolder("testFolder","SelectFolder","RenderFolder")
		If IsNull(folder) Then Exit Sub
	End If

	Call multiIso(objects,array(0,0,0),folder,name,arrResults, arrDrawings)
End Sub
Function multiIso(arrObjects, origin,folder,name, arrBool, arrMode)
	multiIso = Null

	Dim strView
	Dim k: k=0
	Dim count
	Dim arrPoint(),arrTitle()
	ReDim arrPoint(k),arrTitle(k)
	If arrMode(0) = True Then
		ReDim Preserve arrPoint(k+5),arrTitle(k+5),arrSwitch(k+5)
		'plans and elevations
		arrTitle(k) = "Top"
		arrPoint(k) = Array(0,0,1)
		arrTitle(k+1) = "Bottom"
		arrPoint(k+1) = Array(0,0,-1)
		arrTitle(k+2) = "Front"
		arrPoint(k+2) = Array(0,-1,0)
		arrTitle(k+3) = "Back"
		arrPoint(k+3) = Array( 0,1,0)
		arrTitle(k+4) = "Left"
		arrPoint(k+4) = Array(-1,0,0)
		arrTitle(k+5) = "Right"
		arrPoint(k+5) = Array(1,0,0)
		k=k+5
	End If
	If arrMode(1) = True Then
		ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
		'auxilary orthographic elevation
		arrSwitch(k) = True
		arrTitle(k) = "FrontLeft"
		arrPoint(k) = Array(-1,-1,0)
		arrTitle(k+1) = "FrontRight"
		arrPoint(k+1) = Array( 1,-1,0)
		arrTitle(k+2) = "BackLeft"
		arrPoint(k+2) = Array(-1, 1,0)
		arrTitle(k+3) = "BackRight"
		arrPoint(k+3) = Array( 1, 1,0)
		k=k+4
	End If

	If arrMode(2) = True Then
		ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
		'auxilary orthographic top
		arrSwitch(k) = True
		arrTitle(k) = "TopFront"
		arrPoint(k) = Array(0,-1,1)
		arrTitle(k+1) = "TopBack"
		arrPoint(k+1) = Array( 0,1,1)
		arrTitle(k+2) = "TopLeft"
		arrPoint(k+2) = Array(-1,0,1)
		arrTitle(k+3) = "TopRight"
		arrPoint(k+3) = Array( 1,0,1)
		k=k+4
	End If
	If arrMode(3) = True Then
		ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
		'auxilary orthographic bottom
		arrSwitch(k) = True
		arrTitle(k) = "BottomFront"
		arrPoint(k) = Array(0,-1,-1)
		arrTitle(k+1) = "BottomBack"
		arrPoint(k+1) = Array( 0,1,-1)
		arrTitle(k+2) = "BottomLeft"
		arrPoint(k+2) = Array(-1,0,-1)
		arrTitle(k+3) = "BottomRight"
		arrPoint(k+3) = Array( 1,0,-1)
		k=k+4
	End If
	If arrMode(4) = True Then
		ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
		'axonometric isometric top
		arrSwitch(k) = True
		arrTitle(k) = "TopFrontLeft"
		arrPoint(k) = Array(-1,-1,1)
		arrTitle(k+1) = "TopFrontRight"
		arrPoint(k+1) = Array( 1,-1,1)
		arrTitle(k+2) = "TopBackLeft"
		arrPoint(k+2) = Array(-1, 1,1)
		arrTitle(k+3) = "TopBackRight"
		arrPoint(k+3) = Array( 1, 1,1)
		k=k+4
	End If
	If arrMode(5) = True Then
		ReDim Preserve arrPoint(k+4),arrTitle(k+4),arrSwitch(k+4)
		'axonometric isometric bottom
		arrSwitch(k) = True
		arrTitle(k) = "BottomFrontLeft"
		arrPoint(k) = Array(-1,-1,-1)
		arrTitle(k+1) = "BottomFrontRight"
		arrPoint(k+1) = Array( 1,-1,-1)
		arrTitle(k+2) = "BottomBackLeft"
		arrPoint(k+2) = Array(-1, 1,-1)
		arrTitle(k+3) = "BottomBackRight"
		arrPoint(k+3) = Array( 1, 1,-1)
		k=k+4
	End If

	count = k-1
	Dim arrOrigin, vect
	arrOrigin = Array(0,0,0)

	Call Rhino.Command("-_SetView c t ", False)
	strView = Rhino.CurrentView()
	Dim j,m,n,u
	u=0
	Dim obox: obox = Rhino.BoundingBox(arrObjects)
	Dim i,r,s,t
	Dim arrLabel
	Dim invSel
	Dim  arrDrawings(),bbox(), dblLength(), dblHeight(), dblDist
	ReDim arrDrawings(count),bbox(count), dblLength(count), dblHeight(count)
	Call Rhino.EnableRedraw (False)

	If arrBool(0) = True Then
		If j = 0 And m = 0 And n = 0 Then
			Call Rhino.SelectObjects(arrObjects)
			Call Rhino.Command("-_Make2d " ,False)
			Call Rhino.DeleteObjects(Rhino.SelectedObjects())
		Else
			Call Rhino.Command("-_SetView c t ", False)
		End If

		Call Rhino.ViewProjection(strView,1)
		For i = 0 To count Step 1
			Call Rhino.ViewCameraTarget (strView, arrPoint(i), arrOrigin)
			Call Rhino.UnselectAllObjects()
			Call Rhino.SelectObjects(arrObjects)
			Call Rhino.ZoomSelected()
			Call Rhino.Command("-_Make2d d c _Enter" ,False)
			arrDrawings(i) = Rhino.SelectedObjects()
			bbox(i) = Rhino.BoundingBox(arrDrawings(i))
			dblLength(i) = Rhino.Distance(bbox(i)(0),bbox(i)(1))
			dblHeight(i) = Rhino.Distance(bbox(i)(0),bbox(i)(3))
			Call Rhino.UnselectAllObjects()

		Next
		r = 0
		s = 0
		t = 0
		For i = 0 To count Step 1
			ReDim Preserve arrHeight(s)
			arrHeight(s) = dblHeight(i)
			s=s+1
			If arrSwitch(i) = True Then
				t = t+Rhino.max(arrHeight)+3
				ReDim arrHeight(0)
				s = 0
				r = 0
			End If
			If r > 0 Then
				r = dblLength(i)*0.5+dblLength(i-1)*0.5+r
			End If
			Call Rhino.MoveObjects(arrDrawings(i),origin,array(r,u+t,0))
			Call Rhino.AddText(CStr(arrTitle(i)),array(r,u+t-dblHeight(i)*0.2,0),dblHeight(i)*0.1)
			r=r+3
			If i = count Then
				t = t+dblHeight(i)*1.5
			End If
		Next
	End If

	If arrBool(1) = True Then
		If isArray(arrObjects) Then
			Call Rhino.SelectObjects(arrObjects)
		Else
			Call Rhino.SelectObject(arrObjects)
		End If
		invSel = Rhino.InvertSelectedObjects()
		If isNull(invSel) Then
		Else
			Call Rhino.HideObjects(invSel)
		End If
		Call Rhino.UnselectAllObjects()

		Call Rhino.Command("-_SetView c t ", False)
		For i = 0 To count Step 1
			Call Rhino.ViewCameraTarget (strView, arrPoint(i), arrOrigin)
			Call Rhino.SelectObjects(arrObjects)
			Call Rhino.ZoomSelected()
			Call Rhino.Command("_-Render",False)
			Call Rhino.Command("_-SaveRenderWindowAs " & GetRenderFileName(name,folder, CStr(arrTitle(i)), "png"),False)
			Call Rhino.Command("_-CloseRenderWindow",False)
			Call Rhino.UnselectAllObjects()
		Next
	End If
	Call Rhino.EnableRedraw (True)
	Call Rhino.Command("-_SetView c t", False)
	Call Rhino.Command("-_Show _Enter",False)
	Call Rhino.ZoomExtents()
End Function
Function GetRenderFileName(name,folder, view, ext)
	Dim doc, file, temp
	doc = Rhino.DocumentName
	temp = "_"& name &"_"& view & "." & ext
	file = LCase(Replace(doc, ".3dm", temp, 1, -1, 1))
	GetRenderFileName = Chr(34) & folder & file & Chr(34)
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Tuesday, January 06, 2009 8:42:52 PM

Call Main()
Sub Main()
	Dim strReturn, curve, dom, distance, percent, origin
	'Select Curve to Evaluate
	curve = Rhino.GetObject("Select Curve",4)
	If isNull(curve) Then Exit Sub
	reparameterize(curve)

	'Choose Method for Curve Evaluation Parameter of Origin
	strReturn = Rhino.GetString("Evaluate Curve From ","Start",array("Start","Middle","End","Percent","Point"))
	If isNull(strReturn) Then Exit Sub

	'Set Parameter Based on Results
	dom = Rhino.CurveDomain(curve)
	If strReturn = "Start" Then
		origin = dom(0)
	ElseIf strReturn = "Middle" Then
		origin = dom(0)+(dom(1)-dom(0))*0.5
	ElseIf strReturn = "End" Then
		origin = dom(1)
	ElseIf strReturn = "Percent" Then

		percent = Rhino.GetReal("Percent",50,0,100)
		If isNull(percent) Then Exit Sub

		If percent = 0 Then
			origin = dom(0)
		Else
			origin = dom(0)+(dom(1)-dom(0))*(percent*0.01)
		End If
	ElseIf strReturn = "Point" Then
		origin = Rhino.CurveClosestPoint(curve,Rhino.GetPointOnCurve(curve))
		If isNull(origin) Then Exit Sub
	End If

	'Specify Increment Length with which to Evaluate Curve
	distance = Rhino.GetReal("Division Length",10)
	If isNull(distance) Then Exit Sub

	Dim i, j, evalCurve

	Call Rhino.EnableRedraw(False)
	evalCurve = evalCrvByDist(curve, distance, origin)

	For i = 0 To 1 Step 1
		For j = 1 To uBound(evalCurve(i)) Step 1
			Call Rhino.AddTextDot(j,evalCurve(i)(j))
			Call Rhino.AddLine(evalCurve(i)(j-1),evalCurve(i)(j))
		Next
	Next
	Call Rhino.EnableRedraw(True)

End Sub
Function evalCrvByDist(curve,distance, origin)
	evalCrvByDist = Null
	Dim i, j, k, r, s, t
	Dim sphere
	Dim tInt(), pt(), tempT(),pts(1)
	r=0: s=0

	For k = 0 To 1 Step 1
		t = origin
		r=0
		ReDim Preserve pt(r)

		pt(r) = Rhino.EvaluateCurve(curve,t)

		Do
			j=0

			ReDim tempT(0)
			ReDim Preserve tInt(r)

			sphere = Rhino.AddSphere(pt(r),distance)
			tInt(r) = Rhino.CurveSurfaceIntersection(curve,sphere)
			Call Rhino.DeleteObject(sphere)

			For i = 0 To uBound(tInt(r)) Step 1
				If k = 0 Then
					If tInt(r)(i, 0) = 1 And tInt(r)(i,5) > t Then
						s=s+1
						ReDim Preserve tempT(j)
						tempT(j) = tInt(r)(i,5)
						j=j+1
					End If
				Else
					If tInt(r)(i, 0) = 1 And tInt(r)(i,5) < t Then
						s=s+1
						ReDim Preserve tempT(j)
						tempT(j) = tInt(r)(i,5)
						j=j+1
					End If
				End If
			Next

			If s = 0 Then Exit Do
			If k = 0 Then
				t = Rhino.Min(tempT)
			Else
				t = Rhino.Max(tempT)
			End If
			r=r+1
			ReDim Preserve pt(r)
			pt(r) = Rhino.EvaluateCurve(curve,t)
			s=0
		Loop
		pts(k) = pt
	Next
	evalCrvByDist = pts
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Sunday, July 05, 2009 9:42:52 PM

Call Main()
Sub Main()
	Dim arrPts, arrInputs
	arrPts = Rhino.GetObjects("Select Points",1)
	If isNull(arrPts) Then Exit Sub

	arrInputs = Rhino.PropertyListBox(array("Min Length","Max Length" , "Min Hair Bend", "Max Hair Bend","Base Radius","Tip Radius","Segments","Sides"),array(4,12,10,45,0.1,0.01,5,2))
	If isNull(arrInputs) Then Exit Sub

	Dim i, stem(), blades(), sides
	If CInt(arrInputs(7)) < 2 Then
		sides = 2
	Else
		sides = CInt(arrInputs(7))
	End If
	ReDim stem(uBound(arrPts)), blades(uBound(arrPts))
	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(arrPts) Step 1
		stem(i) = segmentedStem(Rhino.PointCoordinates(arrPts(i)),random(CDbl(arrInputs(0)),CDbl(arrInputs(1))),CInt(arrInputs(6)),random(CDbl(arrInputs(2)),CDbl(arrInputs(3))))
		blades(i) = bladesFlat(stem(i),CDbl(arrInputs(4)),CDbl(arrInputs(5)),sides)
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function bladesFlat(arrPlanes,radB,radT,intSteps)
	bladesFlat = Null
	Dim i, j, k, r, arrOutput
	Dim radStep, rotStep
	Dim arrPoints(),arrFaces(), arrMesh()
	ReDim arrMesh(intSteps-1)
	If radB > radT Then
		radStep = -(radB-radT)/uBound(arrPlanes)
	Else
		radStep = (radT-radB)/uBound(arrPlanes)
	End If

	rotStep = 360/intSteps

	For k = 0 To intSteps-1 Step 1
		r=0
		For i = 0 To uBound(arrPlanes) Step 1
			ReDim Preserve arrPoints(r)
			arrPoints(r) = Rhino.PointAdd(arrPlanes(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.RotatePlane(arrPlanes(i),k*rotStep,arrPlanes(i)(3))(1)),radB+i*radStep))
			r=r+1
			ReDim Preserve arrPoints(r)
			arrPoints(r) = Rhino.PointAdd(arrPlanes(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.RotatePlane(arrPlanes(i),(k+1)*rotStep,arrPlanes(i)(3))(1)),radB+i*radStep))
			r=r+1

		Next
		r=0
		ReDim arrFaces(uBound(arrPoints)-2)
		For i = 0 To uBound(arrPoints)-2 Step 2
			arrFaces(r) = array(i,i+1,i+3,i+3)
			r=r+1
			arrFaces(r) = array(i,i+3,i+2,i+2)
			r=r+1
		Next
		If intSteps = 2 Then
			If k=1 Then
				arrOutput = Rhino.addmesh(arrPoints,arrFaces)
			End If
		Else
			arrMesh(k) = Rhino.addmesh(arrPoints,arrFaces)
		End If
	Next
	If intSteps >< 2 Then
		arrOutput = Rhino.MeshBooleanUnion(arrMesh)
	End If
	bladesFlat = arrOutput
End Function
Function segmentedStem(arrPoint,dblHeight,dblSegments,maxRotation)
	segmentedStem = Null
	Dim i, count
	count = dblSegments-1
	Dim dblStep, tempLen, dblLen()
	Dim mPlane(), tmpAngle(1), blnWavy
	ReDim dblLen(count), mPlane(count+1)

	mPlane(0) = Rhino.MovePlane(Rhino.RotatePlane(Rhino.WorldXYPlane(),random(0,360),Rhino.WorldXYPlane()(3)),arrPoint)
	blnWavy = random(-1,1)

	dblStep = dblHeight/dblSegments
	For i = 0 To count Step 1
		If i = 0 Then
			tempLen = random(0.5,1)*dblStep
			dblLen(i) = dblStep-tempLen
		ElseIf i = count Then
			tempLen = dblStep+dblLen(i-1)
		Else
			tempLen = random(0.5,1)*(dblStep+dblLen(i-1))
			dblLen(i) = dblStep+dblLen(i-1)-tempLen
		End If
		If blnWavy >= 0 Then
			tmpAngle(0) = random(0,maxRotation)
			tmpAngle(1) = random(0,maxRotation)
		Else
			tmpAngle(0) = random(-maxRotation,0)
			tmpAngle(1) = random(-maxRotation,0)
		End If
		mPlane(i+1) = Rhino.RotatePlane(Rhino.RotatePlane(Rhino.moveplane(mPlane(i),Rhino.PointAdd(mPlane(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(mPlane(i)(3)),tempLen))),tmpAngle(0),mPlane(i)(1)),tmpAngle(1),mPlane(i)(2))
	Next
	segmentedStem = mPlane
End Function
Function random(min,max)
	random = Null
	Dim dblValue: dblValue = min+(max-min)*rnd()
	random = dblValue
End Function

Option Explicit
'Script written by <David Mans>
'adapted from work by Che Wei Wang
'www.cwwang.com
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, March 18, 2008 7:40:18 AM

Call Main()
Sub Main()
	Dim rows, cols, tol, height,unit
	Dim arrItems, arrValues, arrResults
	arrItems = array("columns","rows","tolerance","maximum_height","unit_width")
	arrValues = array(10,10,0,10,10)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Image Parameters")

	cols = CDbl(arrResults(0))
	rows = CDbl(arrResults(1))
	If CDbl(arrResults(2)) > 1 Then
		tol = 1
	Else
		tol = CDbl(arrResults(2))
	End If

	height = CDbl(arrResults(3))
	unit = CDbl(arrResults(4))

	Dim arrImg, arrExist, strInput

	arrImg = arrImageSample(cols,rows)
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance

	strInput = Rhino.GetString("Select Image Reading Method","Normalized_Pannel",array("Banding","Segments","Cylinders","Horizontal_Plates","Faceted","Normalized_Pannel","Surface","PointCloud"))
	If isNull(strInput) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	If CStr(strInput) = "Banding" Then
		arrExist = banding(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Segments" Then
		arrExist = segments(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Cylinders" Then
		arrExist = cylinders(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Horizontal_Plates" Then
		arrExist = plates(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Faceted" Then
		arrExist = loftPannels(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Normalized_Pannel" Then
		arrExist = uniformPannels(arrImg(6),tol,height,unit)
	End If
	If CStr(strInput) = "Surface" Then
		arrExist = surface(arrImg(6),height,unit)
	End If
	If CStr(strInput) = "PointCloud" Then
		arrExist = cloud(arrImg(0),arrImg(1),arrImg(2),arrImg(6),height,unit)
	End If
	Call Rhino.EnableRedraw(True)

End Sub
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function

	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If

	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If

	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)

	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j

			If x>w Then
				x = w
			End If

			If y>h Then
				y = h
			End If

			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)

		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function plates(arrInput,min,max,spacing)
	plates = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane,plate()
	r = 0
	ReDim plate(r)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(),array(spacing*i,spacing*j,max*arrInput(i)(j)))
				ReDim Preserve plate(r)
				plate(r) = Rhino.AddPlaneSurface(mvPlane, spacing, spacing)

				r =r+1
			End If
		Next
	Next
	plates = plate
End Function
Function cylinders(arrInput,min,max,spacing)
	cylinders = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane,plate()
	r = 0
	ReDim plate(r)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(),array(spacing*i,spacing*j,0))
				ReDim Preserve plate(r)
				plate(r) = Rhino.AddCylinder(mvPlane(0), array(mvPlane(0)(0),mvPlane(0)(1),mvPlane(0)(2)+max*arrInput(i)(j)), spacing*.5)

				r =r+1
			End If
	Next
	Next
	cylinders = plate
End Function
Function banding(arrInput,min,max,spacing)
	banding = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet(),band()
	ReDim band(cols)
	For i = 0 To cols-1 Step 1
		r = 0
		ReDim pSet(r)
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(),array(spacing*i,spacing*j,max*arrInput(i)(j)))

				ReDim Preserve pSet(r)
				pSet(r) = mvPlane(0)
				r =r+1
			End If
		Next
		band(i) = Rhino.AddInterpCurve(pSet)
	Next
	banding = band
End Function
Function surface(arrInput,max,spacing)
	surface = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet()
	r = 0
	ReDim pSet(r)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(),array(spacing*i,spacing*j,max*arrInput(i)(j)))
			ReDim Preserve pSet(r)
			pSet(r) = mvPlane(0)
			r =r+1
		Next
	Next
	Call Rhino.AddSrfPtGrid(array(cols,rows),pSet,array(3,3))
	surface = array()
End Function
Function segments(arrInput,min,max,spacing)
	segments = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet(),band()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i*spacing,j*spacing,max*arrInput(i)(j))
				r=r+1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next

	Dim ptGroup(),ptSet(),arrPts(),crvVal(),crvBln
	ReDim arrPts(cols),crvVal(cols)

	For i = 0 To cols-1 Step 1
		r = 0
		s = 0
		If arrTrFa(i)(0) = True And arrTrFa(i)(1) = True Then
			ReDim Preserve ptGroup(r)
			ptGroup(r) = array(i*spacing,0*spacing,max*arrInput(i)(0))
			r=r+1
		End If
		For j = 1 To rows-1 Step 1

			If arrTrFa(i)(j) = True And arrTrFa(i)(j+1) = True And arrTrFa(i)(j-1) = False Then
				ReDim Preserve ptGroup(r)
				ptGroup(r) = array(i*spacing,j*spacing,max*arrInput(i)(j))
				r=r+1
			End If

			If arrTrFa(i)(j) = True And arrTrFa(i)(j-1) = True Then
				ReDim Preserve ptGroup(r)
				ptGroup(r) = array(i*spacing,j*spacing,max*arrInput(i)(j))
				r = r+1
			End If
			If arrTrFa(i)(j) = True And arrTrFa(i)(j+1) = False Then
				r = 0
				ReDim Preserve ptSet(s)
				ptSet(s) = ptGroup
				s = s+1
			End If
			If s = 0 Then
				crvBln = False
			Else
				crvBln = True
			End If
		Next
		arrPts(i) = ptSet
		crvVal(i) = crvBln
	Next

	Dim cntA,bandSet()
	s=0
	For i = 0 To cols-1 Step 1
		r=0
		If crvVal(i) = True Then
			cntA = uBound(arrPts(i))
			For j = 0 To cntA Step 1
				ReDim band(r)
				band(r) = Rhino.AddCurve(arrPts(i)(j))
				r = r+1
			Next
			ReDim bandSet(s)
			bandSet(s) = band
			s = s+1
		End If
	Next
	segments = bandSet
End Function
Function uniformPannels(arrInput,min,max,spacing)
	uniformPannels = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim pSet()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i*spacing,j*spacing,max*arrInput(i)(j))
				r=r+1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next

	Dim tempSrf,srfPlane()
	tempSrf = Rhino.AddSrfPt(array(array(-spacing*.5,-spacing*.5,0),array(-spacing*.5,spacing*.5,0),array(spacing*.5,spacing*.5,0),array(spacing*.5,-spacing*.5,0)))

	r = 0
	For i = 1 To cols-1 Step 1
		For j = 1 To rows-1 Step 1
			If arrTrFa(i-1)(j) = True And arrTrFa(i)(j) = True And arrTrFa(i)(j-1) = True Then
				ReDim Preserve srfPlane(r)
				srfPlane(r)= Rhino.OrientObject (tempSrf, array(array(0,0,0),array(1,0,0),array(0,1,0)), array(array(i*spacing,j*spacing,max*arrInput(i)(j)), array((i-1)*spacing,j*spacing,max*arrInput(i-1)(j)), array(i*spacing,(j-1)*spacing,max*arrInput(i)(j-1))), 1)
				r = r+1
			End If
		Next
	Next

	Call Rhino.DeleteObject(tempSrf)
	uniformPannels = srfPlane
End Function
Function loftPannels(arrInput,min,max,spacing)
	loftPannels = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim pSet()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)

	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i*spacing,j*spacing,max*arrInput(i)(j))
				r=r+1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next

	Dim srfOutput()
	r = 0
	For i = 1 To cols-1 Step 1
		For j = 1 To rows-1 Step 1
			If arrTrFa(i-1)(j) = True And arrTrFa(i-1)(j-1) = True And arrTrFa(i)(j) = True And arrTrFa(i)(j-1) = True Then
				ReDim Preserve srfOutput(r)
				srfOutput(r) = Rhino.AddSrfPt(array(array((i-1)*spacing,j*spacing,max*arrInput(i-1)(j)),array((i-1)*spacing,(j-1)*spacing,max*arrInput(i-1)(j-1)),array(i*spacing,(j-1)*spacing,max*arrInput(i)(j-1)),array(i*spacing,j*spacing,max*arrInput(i)(j))))
				r=r+1
			End If
		Next
	Next

	loftPannels = srfOutput
End Function
Function cloud(arrInputX,arrInputY,arrInputZ,arrInputR,spacing,rad)
	cloud = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInputX)
	rows = uBound(arrInputX(0))
	Dim mvPlane, arrbln, pSet()
	arrbln = Rhino.GetBoolean("Type of Data Representation",array("Representation","points","spheres"),array(False))
	r = 0
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			ReDim Preserve pSet(r)
			pSet(r)	= array(arrInputX(i)(j)*spacing,arrInputY(i)(j)*spacing,arrInputZ(i)(j)*spacing)

			If arrbln(0) = True Then
				Call Rhino.addsphere(pSet(r),arrInputR(i)(j)*rad)
			Else
				Call Rhino.AddPoint(pSet(r))
			End If
			r =r+1
		Next
	Next
	cloud = pSet
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Thursday, June 26, 2008 9:54:36 PM

Call Main()
Sub Main()
	Call sequential()

End Sub
Function sequential()
	sequential = Null
	Dim pt
	Dim pre, strt, incr, i
	pre = Rhino.GetString("Enter Prefix","",array(""))
	If pre <> "" Then
		pre = pre & "_"
	End If

	strt = Rhino.GetReal("count from = ",0)
	If isNull(strt) Then Exit Function

	incr = Rhino.GetReal("increment = ",1)
	If isNull(incr) Then Exit Function

	i = strt
	Do
		pt = Rhino.GetPoint("press enter to finish")
		If isNull(pt) Then Exit Function
		Call Rhino.AddText(pre & i,pt)
		i = i+incr
	Loop
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Friday, January 16, 2009 9:54:03 PM

Call Main()
Sub Main()
	Dim arrObjects
	arrObjects = Rhino.getobjects("Select Objects to Isolate",,,True)
	If isNull(arrObjects) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Call Rhino.SelectObjects(arrObjects)
	Call Rhino.InvertSelectedObjects()
	Call Rhino.Command("Hide",False)
	Call Rhino.EnableRedraw(True)
End Sub

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, January 19, 2010 11:41:24 PM

Call Main()
Sub Main()
	Dim arrInputs, arrTemp, intCount, arrSorting(), arrGroups
	arrTemp = Rhino.GetObjects("Select Objects to Tile",,True)
	If isNull(arrTemp) Then Exit Sub

	arrGroups = SelectedGroups(arrTemp)

	intCount = uBound(arrGroups)
	ReDim arrSorting(intCount)

	arrInputs = Rhino.PropertyListBox(array("Rotation Min","Rotation Max","Move","Scale% Min","Scale% Max"),array(0,360,0,100,100),"Jitter")
	If isnull(arrinputs) Then Exit Sub

	Dim i, cnPt
	Call Rhino.EnableRedraw(False)
	For i = 0 To intCount Step 1
		arrSorting(i) = Rhino.ObjectsByGroup (arrGroups(i))

		cnPt = boundingBoxCenterPoint(arrSorting(i))
		Call Rhino.ScaleObjects(arrSorting(i),cnPt,array(random(arrInputs(3)*0.01,arrInputs(4)*0.01),random(arrInputs(3)*0.01,arrInputs(4)*0.01),random(arrInputs(3)*0.01,arrInputs(4)*0.01)),False)
		Call Rhino.RotateObjects(arrSorting(i),cnPt,random(arrInputs(0),arrInputs(1)),Rhino.WorldXYPlane()(1),False)
		Call Rhino.RotateObjects(arrSorting(i),cnPt,random(arrInputs(0),arrInputs(1)),Rhino.WorldXYPlane()(2),False)
		Call Rhino.RotateObjects(arrSorting(i),cnPt,random(arrInputs(0),arrInputs(1)),Rhino.WorldXYPlane()(3),False)
		Call Rhino.MoveObjects(arrSorting(i),cnPt,array(cnPt(0)+random(-1*arrInputs(2),arrInputs(2)),cnPt(1)+random(-1*arrInputs(2),arrInputs(2)),cnPt(2)+random(-1*arrInputs(2),arrInputs(2))))
	Next
	Call Rhino.EnableRedraw(True)

End Sub
Function SelectedGroups(arrObjects)
	SelectedGroups = Null 

	Dim arrGroups(), strGroup
	Dim i, nCount, bAppend

	nCount = -1

	For i = 0 To UBound(arrObjects)
		bAppend = False
		strGroup = Rhino.ObjectTopGroup(arrObjects(i))
		If Not IsNull(strGroup) Then
			If (nCount = -1) Then
				bAppend = True
			ElseIf (FindGroup(strGroup, arrGroups) = -1) Then
				bAppend = True
			End If
			If bAppend = True Then
				nCount = nCount + 1
				ReDim Preserve arrGroups(nCount)
				arrGroups(nCount) = strGroup
			End If
		End If
	Next

	If (nCount > -1) Then SelectedGroups = arrGroups

End Function
Function FindGroup(strGroup, arrGroups)
	Dim i
	FindGroup = -1
	For i = 0 To UBound(arrGroups)
		If (StrComp(strGroup, arrGroups(i), 1) = 0) Then
			FindGroup = i
			Exit Function
		End If
	Next
End Function
Function boundingBoxCenterPoint(arrInputs)
	boundingBoxCenterPoint = Null
	Dim b,arrPt
	b = Rhino.BoundingBox(arrInputs)

	arrPt = array(b(0)(0)+(b(1)(0)-b(0)(0))*0.5,b(0)(1)+(b(3)(1)-b(0)(1))*0.5,b(0)(2)+(b(4)(2)-b(0)(2))*0.5)
	boundingBoxCenterPoint = arrPt
End Function
Function random(min,max)
	random = Null
	Dim dblValue: dblValue = min+(max-min)*rnd()
	random = dblValue
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Sunday, August 30, 2009 1:22:47 AM

Call Main()
Sub Main()
	Dim strCurve
	strCurve = Rhino.GetObject("Select Curve",4,True)
	If isNull(strCurve) Then Exit Sub
	Call reparameterize(strCurve)

	Dim arrItems, arrValues, arrReturns
	arrItems = array("Strands","Rotations","Strand Oscillations","Min Radius","Max Radius","Radius Oscillations","Samples")
	arrValues= array(8,0,4,1,2,4,18)
	arrReturns = Rhino.PropertyListBox (arrItems, arrValues ,,"Parameters")
	If isNull(arrReturns) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Call curveLattice(strCurve,CInt(arrReturns(0)),CInt(arrReturns(2)),CDbl(arrReturns(1)),array(CDbl(arrReturns(3)),CDbl(arrReturns(4))),CInt(arrReturns(5)),CInt(arrReturns(6)))
	Call Rhino.EnableRedraw(True)

End Sub
Function curveLattice(strCurve,intStrands,intOscillations, dblRotation, arrRadius, intRadius, intSamples)
	curveLattice = Null
	intOscillations = intOscillations*2

	Dim i,j, count, tDom, tStep, rStep, dblSc
	Dim tFrame, rFrame
	Dim arrOutput(),arrPt()

	count = intSamples*intOscillations
	ReDim arrPt(count), arrOutput(intStrands)

	tDom = Rhino.CurveDomain(strCurve)
	tStep = (tDom(1)-tDom(0))/count
	rStep = 360/intStrands
	dblSc = arrRadius(1)-arrRadius(0)

	For i = 0 To intStrands-1 Step 1
		For j = 0 To count Step 1
			tFrame = Rhino.CurvePerpFrame(strCurve,tDom(0)+tStep*j)
			If i Mod(2) Then
				rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*sin(intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
			Else
				rFrame = Rhino.RotatePlane(tFrame,rStep*i+(rStep*0.5)*sin(PI+intOscillations*PI*(j/count))+(360*dblRotation)*j/count,tFrame(3))
			End If
			arrPt(j) = Rhino.PointAdd(tFrame(0),Rhino.VectorScale(Rhino.VectorUnitize(rFrame(1)),arrRadius(0)+dblSc+dblSc*cos(intRadius*PI*(j/count))))
		Next
		arrOutput(i) = arrPt
		Call Rhino.AddInterpCurve(arrPt)
	Next

	curveLattice = arrOutput
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1")
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1")
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, December 02, 2008 9:25:59 AM

Call Main()
Sub Main()
	Dim arrLayers,layers, prefix

	arrLayers = Rhino.LayerNames(True)

	layers = Rhino.MultiListBox (arrLayers, "Select Layers")
	If isNull(layers) Then Exit Sub

	prefix = Rhino.StringBox("Type Prefix")
	If isNull(prefix) Then Exit Sub

	Dim i

	Call Rhino.EnableRedraw(False)

	For i = 0 To uBound(layers) Step 1
		Call Rhino.RenameLayer(layers(i), prefix & layers(i))
	Next

	Call Rhino.EnableRedraw(True)
End Sub

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, June 08, 2008 1:19:49 AM

Call Main()
Sub Main()
	Dim crv: crv = Rhino.GetObjects("Select Curves",4)
	If isNull(crv) Then Exit Sub
	Dim arrItems, arrValues, arrResults
	arrItems = array("scale_width","twist_angle","tip_location","tip_angle","start_width","end_width","tip_length","type_(1)or(2)","curved arrows")
	arrValues = array(1,0,.95,45,.2,.5,1,1,True)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Arrow Parameters")
	Dim i
	If arrResults(0) < .1 Then
		arrResults(0) = .1
	End If
	If arrResults(2) > .99 Then
		arrResults(2) = .99
	End If
	If arrResults(4) < .01 Then
		arrResults(4) = .01
	End If
	If arrResults(5) < .01 Then
		arrResults(5) = .01
	End If
	If arrResults(7) < 1 Then
		arrResults(7) = 0
	ElseIf arrResults(7) > 1 Then
		arrResults(7) = 1
	End If

	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(crv) Step 1
		Call reparameterize(crv(i))
		Call curveArrows(crv(i),CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(5)),CDbl(arrResults(6)),CInt(arrResults(7)),CBool(arrResults(8)))
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function curveArrows(curve, dblScale,twistAngle,tip,headAngle,edgeParaA,edgeParaB,width,dblType,CrvBln)
	curveArrows = Null
	Dim i,j, crv, tipEdge, crvCpy, crvDom, dis,scale, count, crvFrame, strProfSet(1),tempCrv, crvX, srf(3)
	Dim endPt, midPtA, midPtB
	count = 2+CInt(twistAngle/90)
	ReDim frame(count), pt(count*2+1), swProfSetA(count-1), swProfSetB(count-1),crvA(count-1),crvB(count-1),parameter(count)
	ReDim srfEdge(2), edgeA(count-1), edgeB(count-1)

	If width <> 0 Then
		tip = (Rhino.CurveLength(curve)-width)/Rhino.CurveLength (curve)
	End If
	crvDom = Rhino.CurveDomain(curve)(1)
	parameter(0) = 0
	For i = 0 To count-1 Step 1
		parameter(i) = (crvDom*tip/(count-1))*i
	Next
	parameter(count) = crvDom-(crvDom-crvDom*tip)*.5

	dis = Rhino.Distance(Rhino.EvaluateCurve(curve,crvDom*tip),Rhino.EvaluateCurve(curve,crvDom))*dblScale
	scale = dis*0.5

	j=0
	For i = 0 To count Step 1
		crvFrame = Rhino.CurveFrame(curve,parameter(i))
		If i = count Then
			frame(i) = Rhino.RotatePlane(crvFrame,(twistAngle/(count-1))*(i-1),crvFrame(1))
		Else
			frame(i) = Rhino.RotatePlane(crvFrame,(twistAngle/(count-1))*i,crvFrame(1))
		End If
		pt(j) = Rhino.PointAdd(frame(i)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(i)(2),scale),90-headAngle,frame(i)(3)))
		j=j+1
		pt(j) = Rhino.PointAdd(frame(i)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(i)(2),scale),90+headAngle,frame(i)(3)))
		j=j+1
		If i<count Then
			If CrvBln = True Then
				tempCrv = Rhino.AddInterpCurve(array(pt(j-2),frame(i)(0),pt(j-1)),3)
			Else
				tempCrv = Rhino.AddInterpCurve(array(pt(j-2),frame(i)(0),pt(j-1)),1)
			End If
			crvX = Rhino.SplitCurve(tempCrv,Rhino.CurveDomain(tempCrv)(1)*.5,True)
			reparameterize(crvX(0))
			crvA(i) = crvX(0)
			reparameterize(crvX(1))
			crvB(i) = crvX(1)
		End If
	Next
	crvCpy = Rhino.CopyObject(curve)
	crv = Rhino.SplitCurve (crvCpy , crvDom*tip,True)
	endPt = Rhino.EvaluateCurve(curve,crvDom)
	midPtA= Rhino.PointAdd(frame(count)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(count)(2),scale*.5),90-headAngle,frame(count)(3)))
	midPtB= Rhino.PointAdd(frame(count)(0),Rhino.VectorRotate(Rhino.VectorScale(frame(count)(2),scale*.5),90+headAngle,frame(count)(3)))

	srfEdge(0) = Rhino.AddInterpCurve(array(endPt,midPtA,pt(j-4)))
	srfEdge(1) = Rhino.AddInterpCurve(array(endPt,midPtB,pt(j-3)))
	srfEdge(2) = Rhino.AddInterpCurve(array(endPt,frame(count)(0),frame(count-1)(0)))
	If dblType = 1 Then
		srf(0) = Rhino.AddEdgeSrf (array(crvA(count-1),crv(1),srfEdge(0)))
	End If
	srf(1) = Rhino.AddEdgeSrf (array(crvB(count-1),crv(1),srfEdge(1)))
	If edgeParaA>edgeParaB Then
		edgeParaB = -(edgeParaA-edgeParaB)/(count-1)
	ElseIf edgeParaB>edgeParaA Then
		edgeParaB = (edgeParaB-edgeParaA)/(count-1)
	Else
		edgeParaB = 0
	End If
	For i = 0 To  count-1 Step 1
		edgeA(i) = Rhino.SplitCurve(crvA(i),Rhino.CurveDomain(crvA(i))(1)*(1-(edgeParaA+edgeParaB*i)),True)
		edgeB(i) = Rhino.SplitCurve(crvB(i),Rhino.CurveDomain(crvB(i))(1)*(edgeParaA+edgeParaB*i),True)
	Next
	For i = 0 To count-1 Step 1
		swProfSetA(i) = ("_SelID " & edgeA(i)(1) & " ")
		swProfSetB(i) = ("_SelID " & edgeB(i)(0) & " ")

	Next
	strProfSet(0) = Join(swProfSetA)
	strProfSet(1) = Join(swProfSetB)
	If dblType = 1 Then
		Call Rhino.Command( "-_Sweep1 " & "_SelID " & crv(0) & " " & strProfSet(0) & " _Enter _Simplify=None Enter")
		srf(2)= Rhino.FirstObject()
	End If
	Call Rhino.Command( "-_Sweep1 " & "_SelID " & crv(0) & " " & strProfSet(1) & " _Enter  _Simplify=None Enter")
	srf(3)= Rhino.FirstObject()

	If dblType = 1 Then
		Call Rhino.JoinSurfaces(srf,True)
	Else
		Call Rhino.JoinSurfaces(array(srf(1),srf(3)),True)
	End If
	Call Rhino.DeleteObjects(crv)
	Call Rhino.DeleteObjects(srfEdge)
	For i = 0 To count-1 Step 1
		Call Rhino.DeleteObjects(edgeA(i))
		Call Rhino.DeleteObjects(edgeB(i))
	Next
End Function
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

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Monday, March 17, 2008 6:54:49 PM

Call Main()
Sub Main()
	Dim objects, object
	objects = Rhino.GetObjects("Select Surfaces",8)
	If isNull(objects) Then Exit Sub
	Call Rhino.EnableRedraw(False)
	object = MedianObject(objects)
	Call Rhino.EnableRedraw(True)

End Sub
Function MedianObject(surfaces)
	MedianObject = 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, objCopy
	Udom = Rhino.Max(domU)
	Vdom = Rhino.Max(domV)
	Ucount = Rhino.Max(arrU)
	Vcount = Rhino.Max(arrV)

	Dim ptCount: ptCount = Ucount*Vcount-1

	Dim ptX(), ptY(), ptZ(),ptXset(),ptYset(),ptZset()
	Dim srfXmin(),srfYmin(),srfZmin()
	ReDim srfPts(Vcount),srfPtSet(Ucount),arrSrfPts(objCount)
	ReDim ptX(ptCount), ptY(ptCount), ptZ(ptCount),ptXset(objCount),ptYset(objCount),ptZset(objCount)
	ReDim srfXmin(objCount),srfYmin(objCount),srfZmin(objCount)

	'rebuild the surfaces based on max values
	For i = 0 To objCount Step 1
		objCopy = Rhino.CopyObject(surfaces(i))
		Call Rhino.ObjectColor(objCopy,RGB(255,0,0))
		surfRe = Rhino.RebuildSurface(objCopy,array(Udom,Vdom),array(Ucount,Vcount))
		srfPts(i) = Rhino.SurfacePoints(objCopy)
		'extract control points
		For j = 0 To ptCount Step 1
			ptX(j) = srfPts(i)(j)(0)
			ptY(j) = srfPts(i)(j)(1)
			ptZ(j) = srfPts(i)(j)(2)
		Next
		srfXmin(i) = Rhino.Min(ptX)
		srfYmin(i) = Rhino.Min(ptY)
		srfZmin(i) = Rhino.Min(ptZ)
		'normalize the point sets
		For j = 0 To ptCount Step 1
			ptX(j) = ptX(j)-srfXmin(i)
			ptY(j) = ptY(j)-srfYmin(i)
			ptZ(j) = ptZ(j)-srfZmin(i)
		Next
		ptXset(i) = ptX
		ptYset(i) = ptY
		ptZset(i) = ptZ
		Call Rhino.DeleteObject(objCopy)
	Next
	'construct a surface at the model space centerpoint which is the median of the existing surfaces
	Dim ptMed(), ptXmed, ptYmed(), ptZmed(), ptXtemp(), ptYtemp(), ptZtemp()
	ReDim ptMed(ptCount), ptXmed(ptCount), ptYmed(ptCount), ptZmed(ptCount), ptXtemp(objCount), ptYtemp(objCount), ptZtemp(objCount)
	For i = 0 To ptCount Step 1
		For j = 0 To objCount Step 1
			ptXtemp(j) = ptXset(j)(i)
			ptYtemp(j) = ptYset(j)(i)
			ptZtemp(j) = ptZset(j)(i)
		Next
		ptXmed(i) = Rhino.Sum(ptXtemp)/(objCount+1)
		ptYmed(i) = Rhino.Sum(ptYtemp)/(objCount+1)
		ptZmed(i) = Rhino.Sum(ptZtemp)/(objCount+1)

		ptMed(i) = array(ptXmed(i),ptYmed(i),ptZmed(i))
	Next
	Dim endSurf
	endSurf = Rhino.AddSrfControlPtGrid(array(Ucount,Vcount), ptMed,array(Udom,Vdom))

	MedianObject = endSurf
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Saturday, December 27, 2008 9:23:06 PM

Call Main()
Sub Main()
	Dim i,j, curveSets()
	ReDim curveSets(0)
	curveSets(0) = Rhino.GetObjects("Select Curve Set 1",4)
	If isNull(curveSets(0)) Then Exit Sub
	i = 0
	j = 0

	Do Until j = 1
		i=i+1
		ReDim Preserve curveSets(i)
		curveSets(i) = Rhino.GetObjects("Select Curve Set " & i+1,4)
		If isNull(curveSets(i)) Then
			j=1
		End If
	Loop
	ReDim Preserve curveSets(i-1)

	Call multiLoft(curveSets)
End Sub
Function multiLoft(curveSets)
	multiLoft = Null
	Dim i
	Call Rhino.Command("-_SelNone",False)

	Call Rhino.SelectObjects(curveSets(0))
	Call Rhino.Command("-_Loft",False)
	Call Rhino.EnableRedraw(False)
	For i = 1 To uBound(curveSets) Step 1
		Call Rhino.SelectObjects(curveSets(i))
		Call Rhino.Command("-_Loft _enter _enter",False)
		Call Rhino.Command("-_SelNone",False)
	Next
	Call Rhino.EnableRedraw(True)

End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, September 14, 2008 1:39:30 PM

Call Main()
Sub Main()
	Dim curves, radA, radB, cap
	curves = Rhino.GetObjects("Select Curves",4,,True)
	If isNull(curves) Then Exit Sub

	radA = Rhino.GetReal("Start Radius",1)
	If isNull(radA) Then Exit Sub

	radB = Rhino.GetReal("End Radius",2)
	If isNull(radB) Then Exit Sub

	cap = Rhino.GetString("Cap Type","Flat",array("Flat","None","Round"))
	If isNull(cap) Then Exit Sub

	If cap = "Flat" Then
		cap = "f"
	ElseIf cap = "None" Then
		cap = "n"
	ElseIf cap = "Round" Then
		cap = "r"
	End If	

	Call Multipipe(curves,array(radA,radB),cap)

End Sub
Function Multipipe(curves,arrRadius,cap)
	Multipipe = Null
	Dim i
	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(curves) Step 1
		If Rhino.IsCurveClosed(curves(i))=False Then
			Call Rhino.Command( "-_Pipe " & "_SelID " & curves(i) & " c " & CStr(cap) & " " & CDbl(arrRadius(0)) & " _Enter " & CDbl(arrRadius(1)) & " _Enter _Enter",False)
		Else
			Call Rhino.Command( "-_Pipe " & "_SelID " & curves(i) & CDbl(arrRadius(0)) & " _Enter _Enter",False)
		End If
	Next
	Call Rhino.EnableRedraw(True)

End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Wednesday, April 30, 2008 4:08:50 PM

Call Main()
Sub Main()
	Dim objects,inputs,width,height,scale,boarder
	objects = Rhino.GetObjects("Select Curves")
	If isNull(objects) Then Exit Sub
	Dim i,r,s, blnGrp(), grp,ngrp, count
	grp = False: ngrp = False
	i=0: r=0: s=0
	ReDim blnGrp(uBound(objects))
	Dim groups, obj(), grps()
	ReDim grps(r),obj(s)
	For i = 0 To uBound(objects) Step 1
		If Rhino.IsObjectInGroup(objects(i)) Then
			ReDim Preserve grps(r)
			grps(r)= objects(i)
			grp = True
			r=r+1
		Else
			ReDim Preserve obj(s)
			obj(s) = objects(i)
			blnGrp(s) = False
			ngrp = True
			s=s+1
		End If
	Next
	s=0
	If grp = True And ngrp = False Then
		ReDim blnGrp(0)
		inputs = groupsFromObjects(objects)
		For i = 0 To uBound(inputs) Step 1
			ReDim Preserve blnGrp(i)
			blnGrp(i) = True
		Next
	End If
	If ngrp = True And grp = False Then
		inputs = objects
		For i = 0 To uBound(inputs) Step 1
			blnGrp(i) = False
		Next
	End If
	If grp = True And ngrp = True Then
		groups = groupsFromObjects(grps)
		count = uBound(groups)+uBound(obj)+1
		ReDim inp(count)
		For i = 0 To uBound(groups) Step 1
			inp(s) = groups(i)
			blnGrp(s) = True
			s=s+1
		Next
		For i = 0 To uBound(obj) Step 1
			inp(s) = obj(i)
			blnGrp(s) = False
			s=s+1
		Next
		inputs = inp
	End If

	Dim arrItems, arrValues, arrReturns
	arrItems = array("Maximum_Width","Maximum_Height","Scale_Factor","Boarder_Width","Rotational_Alignment","World_Orientation")
	arrValues= array(32,18,1,.25,True, True)
	arrReturns = Rhino.PropertyListBox (arrItems, arrValues ,,"Transform Parameters")
	If isNull(arrReturns) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Call TileCurves(inputs,CDbl(arrReturns(0)),CDbl(arrReturns(1)),CDbl(arrReturns(2)),CDbl(arrReturns(3)),CBool(arrReturns(4)),CBool(arrReturns(5)),blnGrp)
	Call Rhino.EnableRedraw(True)

End Sub
Function TileCurves(curves,width,height,scale,board,align,orient,group)
	TileCurves = Null
	Dim i,j,k,r,s,t,u,v,a,stps,count
	count = uBound(curves)
	Dim tempCv,testCv,wPlane,sort,minH,minR,tBox,tempTxt
	wPlane = Rhino.WorldXYPlane()
	ReDim bBox(count),wid(count),hgt(count),obj(count),centPt(count),cutObj(count),txtH(count),lblH(count)
	ReDim h(count),w(count),c(count),cA(count),rotVal(count)
	ReDim areaV(89)

	If Rhino.IsLayer("scores") = False Then
		Call Rhino.AddLayer("scores",RGB(255,0,0))
	End If
	If Rhino.IsLayer("labels") = False Then
		Call Rhino.AddLayer("labels",RGB(0,0,0))
	End If
	If Rhino.IsLayer("cuts") = False Then
		Call Rhino.AddLayer("cuts",RGB(0,255,0))
	End If
	If Rhino.IsLayer("frame") = False Then
		Call Rhino.AddLayer("frame",RGB(0,0,0))
	End If
	'create cutting reference box
	Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(0,0,0),array(0,height,0),array(width,height,0),array(width,0,0),array(0,0,0))),"frame")
	Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(board,board,0),array(board,height-board,0),array(width-board,height-board,0),array(width-board,board,0),array(board,board,0))),"frame")

	'determine boundry dimensions and copy object for packing
	Dim oPts, obox, oArea(), oMin
	For i = 0 To count Step 1
		If group(i) = True Then
			testCv = Rhino.CopyObjects(curves(i))
		Else
			testCv = Rhino.CopyObject(curves(i))
		End If
		'search for optimal orientation based on curve points, optimal for boxes.
		' Will Not Work If Objects Are Grouped!
		If group(i) = False Then
			If orient = True Then
				oPts = Rhino.CurveEditPoints(testCv)
				s = 0
				ReDim oArea(s), oOri(s)
				For j = 0 To uBound(oPts)-1 Step 1
					For k = j To uBound(oPts)-1 Step 1
						If j <> k Then
							ReDim Preserve oArea(s), oOri(s)
							oPts = Rhino.CurveEditPoints(testCv)
							oOri(s) = array(j,k)
							Call Rhino.OrientObject(testCv,array(oPts(j),oPts(k)),array(oPts(j),array(oPts(j)(0),oPts(j)(1)+1,oPts(j)(2))))
							obox = Rhino.BoundingBox(testCv)
							oArea(s)= Rhino.Distance(obox(0),obox(1))*Rhino.Distance(obox(0),obox(3))
							s = s+1
						End If
					Next
				Next
				oMin = Rhino.Min(oArea)
				k = 0: j = 0
				Do Until j = s Or k = 1
					If oArea(j) = oMin Then
						oPts = Rhino.CurveEditPoints(testCv)
						Call Rhino.OrientObject(testCv,array(oPts(oOri(j)(0)),oPts(oOri(j)(1))),array(oPts(oOri(j)(0)),array(oPts(oOri(j)(0))(0),oPts(oOri(j)(0))(1)+1,oPts(oOri(j)(0))(2))))
						k=1
					End If
					j=j+1
				Loop
			End If
		End If

		bBox(i) = Rhino.BoundingBox(testCv)
		tempCv = Rhino.AddLine(bBox(i)(0),bBox(i)(2))
		centPt(i) = Rhino.CurveMidPoint(tempCv)
		Call Rhino.DeleteObject(tempCv)
		If align = True Then
			For j = 0 To 89 Step 1
				If group(i) = True Then
					Call Rhino.RotateObjects(testCv,centPt(i),1,wPlane(3))
				Else
					Call Rhino.RotateObject(testCv,centPt(i),1,wPlane(3))
				End If
				tBox = Rhino.BoundingBox(testCv)
				areaV(j) = Rhino.Distance(tBox(0),tBox(1))*Rhino.Distance(tBox(0),tBox(3))
			Next
			If group(i) = True Then
				Call Rhino.RotateObjects(testCv,centPt(i),-89,wPlane(3))
			Else
				Call Rhino.RotateObject(testCv,centPt(i),-89,wPlane(3))
			End If
			minR = Rhino.Min(areaV)
			For j = 0 To 89 Step 1
				If areaV(j) = minR Then
					rotVal(i) = j
				End If
			Next
		End If

		obj(i) = testCv
		If align = True Then
			If group(i) = True Then
				Call Rhino.RotateObjects(obj(i),centPt(i),rotVal(i),wPlane(3))
			Else
				Call Rhino.RotateObject(obj(i),centPt(i),rotVal(i),wPlane(3))
			End If
		End If
		bBox(i) = Rhino.BoundingBox(obj(i))
		wid(i) = Rhino.Distance(bBox(i)(0),bBox(i)(1))
		hgt(i) = Rhino.Distance(bBox(i)(0),bBox(i)(3))
		txtH(i)= hgt(i)
		'scale packing objects and rotate to maximize packing
		If wid(i)<hgt(i) Then
			txtH(i) = wid(i)
			If group(i) = True Then
				Call Rhino.RotateObjects(obj(i),centPt(i),90,wPlane(3))
			Else
				Call Rhino.RotateObject(obj(i),centPt(i),90,wPlane(3))
			End If
		End If
		If group(i) = True Then
			Call Rhino.ScaleObjects(obj(i),centPt(i),array(scale,scale,1))
		Else
			Call Rhino.ScaleObject(obj(i),centPt(i),array(scale,scale,1))
		End If
		bBox(i) = Rhino.BoundingBox(obj(i))
		tempCv = Rhino.AddLine(bBox(i)(0),bBox(i)(2))
		centPt(i) = Rhino.CurveMidPoint(tempCv)
		Call Rhino.DeleteObject(tempCv)
		wid(i) = Rhino.Distance(bBox(i)(0),bBox(i)(1))
		hgt(i) = Rhino.Distance(bBox(i)(0),bBox(i)(3))
	Next
	If	Rhino.Max(wid)-Rhino.Min(wid) > Rhino.Max(hgt)-Rhino.Min(hgt) Then
		For i = 0 To count Step 1
			If group(i) = True Then
				Call Rhino.RotateObjects(obj(i),centPt(i),90,wPlane(3))
			Else
				Call Rhino.RotateObject(obj(i),centPt(i),90,wPlane(3))
			End If
			bBox(i) = Rhino.BoundingBox(obj(i))
			tempCv = Rhino.AddLine(bBox(i)(0),bBox(i)(2))
			centPt(i) = Rhino.CurveMidPoint(tempCv)
			Call Rhino.DeleteObject(tempCv)
			wid(i) = Rhino.Distance(bBox(i)(0),bBox(i)(1))
			hgt(i) = Rhino.Distance(bBox(i)(0),bBox(i)(3))
		Next
		v = True
	Else
		v = False
	End If	

	sort = Rhino.SortNumbers(wid,False)
	minH = Rhino.Min(hgt)
	If minH < .1 Then
		minH = .1
	End If

	'conditional reDimensions array through an elimination process preventing duplicates
	Dim tmpObj,tmpWid,blnMe
	tmpObj = obj
	tmpWid = wid
	For i = 0 To count Step 1
		a = 0
		blnMe = False
		For j = 0 To count-i Step 1
			If sort(i) = tmpWid(j) And blnMe = False Then
				cutObj(i) = tmpObj(j)

				blnMe = True
			Else
				tmpObj(a) = tmpObj(j)
				tmpWid(a) = tmpWid(j)
				txtH(a) = txtH(j)

				a = a+1
			End If
		Next
		ReDim Preserve tmpObj(count-i-1)
		ReDim Preserve tmpWid(count-i-1)
	Next

	'Resequence according to scale to maximize wasted space
	For i = 0 To count Step 1
		bBox(i) = Rhino.BoundingBox(cutObj(i))
		tempCv = Rhino.AddLine(bBox(i)(0),bBox(i)(2))
		c(i) = Rhino.CurveMidPoint(tempCv)
		h(i) = Rhino.Distance(bBox(i)(0),bBox(i)(3))
		w(i) = Rhino.Distance(bBox(i)(0),bBox(i)(1))
		Call Rhino.DeleteObject(tempCv)
		Call Rhino.ObjectLayer(cutObj(i),"cuts")
	Next
	'check that objects are within frame dimensions
	For i = 0 To count Step 1
		If h(i) > height-board*2 Then
			Call Rhino.Print("Object to Large to Cut")
			Call Rhino.ObjectColor(cutObj(i),RGB(255,255,255))
			Exit Function
		End If
		If w(i) > width-board*2 Then
			Call Rhino.Print("Object to Large to Cut")
			Call Rhino.ObjectColor(cutObj(i),RGB(255,255,255))
			Exit Function
		End If
	Next
	'pack according to dimensional limits
	r = board
	s = board
	t = 0
	u = 0
	Dim lblTxt, xbox, xln
	For i = 0 To count Step 1
		xbox = Rhino.BoundingBox(curves(i))
		xln = Rhino.AddLine(xbox(0),xbox(2))
		lblTxt = Rhino.AddText(i,Rhino.CurveMidPoint(xln),txtH(count-i)*.5)
		Call Rhino.DeleteObject(xln)
		Call Rhino.ObjectLayer(lblTxt,"labels")
		If s+board+h(i) > height-board Then
			s = board
			r = r+t+w(i)*.5
			t = w(i)*.5
		End If

		If r+w(i)*.5 > width*u+width-board*2 Then
			u = u+1
			r = width*u+board+w(i)*.5
			Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width*u,0,0),array(width*u,height,0),array(width*u+width,height,0),array(width*u+width,0,0),array(width*u,0,0))),"frame")
			Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width*u+board,board,0),array(width*u+board,height-board,0),array(width*u+width-board,height-board,0),array(width*u+width-board,board,0),array(width*u+board,board,0))),"frame")
		End If

		If i = 0 Then
			r = board+w(i)*.5
			s = board+h(i)*.5
			t = w(i)*.5
			If group(i) = True Then
				Call Rhino.moveobjects(cutObj(i),c(i),array(r,s,0))
			Else
				Call Rhino.moveobject(cutObj(i),c(i),array(r,s,0))
			End If
			cA(i) = array(board,board,0)
			s = s+h(i)*.5
		Else
			s = s+h(i)*.5
			If group(i) = True Then
				Call Rhino.moveobjects(cutObj(i),c(i),array(r,s,0))
			Else
				Call Rhino.moveobject(cutObj(i),c(i),array(r,s,0))
			End If
			cA(i) = array(r-w(i)*.5,s-h(i)*.5,0)
			s = s+h(i)*.5
		End If
		If v = False Then
			Call Rhino.ObjectLayer(Rhino.AddText(i,cA(i),txtH(count-i)*scale*.5),"scores")
		Else
			tempTxt = Rhino.AddText(i,array(cA(i)(0)+w(i),cA(i)(1),cA(i)(2)),txtH(count-i)*scale*.5)
			Call Rhino.ObjectLayer(tempTxt,"scores")
			Call Rhino.RotateObject(tempTxt,array(cA(i)(0)+w(i),cA(i)(1),cA(i)(2)),90,wPlane(3))
		End If
	Next
End Function
Function groupsFromObjects(obj)
	groupsFromObjects = Null
	Dim i,j,r,s, count, grp, box, grpObj()
	count = uBound(obj)
	ReDim grp(count), group(0)
	s=0
	For i = 0 To count Step 1
		grp(i) = Rhino.ObjectTopGroup(obj(i))
		If i > 0 Then
			r=0
			j=0
			Do Until j = s
				If  grp(i) <> group(j) Then
					r=r+1
				End If
				j=j+1
			Loop
			If r = s Then
				ReDim Preserve group(s)
				group(s) = grp(i)
				s=s+1
			End If
		Else
			group(s) = grp(i)
			s=1
		End If
	Next
	ReDim grpObj(uBound(group))
	For i = 0 To uBound(group) Step 1
		grpObj(i) = Rhino.ObjectsByGroup (group(i))
	Next
	groupsFromObjects = grpObj
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Sunday, July 05, 2009 9:42:52 PM

Call Main()
Sub Main()
	Dim strSurface, arrInputs

	strSurface = Rhino.GetObject("Select Surface",8)
	If isNull(strSurface) Then Exit Sub
	Call reparameterize(strSurface)

	arrInputs = Rhino.PropertyListBox(array("Count","Min Length","Max Length" , "Min Hair Bend", "Max Hair Bend","Base Radius","Tip Radius","Segments","Sides"),array(1000,4,12,10,45,0.1,0.01,5,2))
	If isNull(arrInputs) Then Exit Sub

	Dim i, stem(), blades(), sides
	If CInt(arrInputs(7)) < 2 Then
		sides = 2
	Else
		sides = CInt(arrInputs(7))
	End If

	Dim arrPlanes

	Call Rhino.EnableRedraw(False)
	arrPlanes = randomPtsSrf(strSurface,CInt(arrInputs(0)))

	ReDim stem(uBound(arrPlanes)), blades(uBound(arrPlanes))
	For i = 0 To uBound(arrPlanes) Step 1
		stem(i) = segmentedStem(arrPlanes(i),random(CDbl(arrInputs(1)),CDbl(arrInputs(2))),CInt(arrInputs(7)),random(CDbl(arrInputs(3)),CDbl(arrInputs(4))))
		blades(i) = bladesFlat(stem(i),CDbl(arrInputs(5)),CDbl(arrInputs(6)),sides)
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function randomPtsSrf(strSurface,intCount)
	randomPtsSrf = Null
	Dim i, uDom, vDom, arrOutput()
	ReDim arrOutput(intCount-1)
	uDom = Rhino.SurfaceDomain(strSurface,0)
	vDom = Rhino.SurfaceDomain(strSurface,1)

	For i = 0 To intCount-1 Step 1
		arrOutput(i) = Rhino.SurfaceFrame(strSurface,array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1))))
	Next

	randomPtsSrf = arrOutput
End Function
Function bladesFlat(arrPlanes,radB,radT,intSteps)
	bladesFlat = Null
	Dim i, j, k, r, arrOutput
	Dim radStep, rotStep
	Dim arrPoints(),arrFaces(), arrMesh()
	ReDim arrMesh(intSteps-1)
	If radB > radT Then
		radStep = -(radB-radT)/uBound(arrPlanes)
	Else
		radStep = (radT-radB)/uBound(arrPlanes)
	End If

	rotStep = 360/intSteps

	For k = 0 To intSteps-1 Step 1
		r=0
		For i = 0 To uBound(arrPlanes) Step 1
			ReDim Preserve arrPoints(r)
			arrPoints(r) = Rhino.PointAdd(arrPlanes(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.RotatePlane(arrPlanes(i),k*rotStep,arrPlanes(i)(3))(1)),radB+i*radStep))
			r=r+1
			ReDim Preserve arrPoints(r)
			arrPoints(r) = Rhino.PointAdd(arrPlanes(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.RotatePlane(arrPlanes(i),(k+1)*rotStep,arrPlanes(i)(3))(1)),radB+i*radStep))
			r=r+1

		Next
		r=0
		ReDim arrFaces(uBound(arrPoints)-2)
		For i = 0 To uBound(arrPoints)-2 Step 2
			arrFaces(r) = array(i,i+1,i+3,i+3)
			r=r+1
			arrFaces(r) = array(i,i+3,i+2,i+2)
			r=r+1
		Next
		If intSteps = 2 Then
			If k=1 Then
				arrOutput = Rhino.addmesh(arrPoints,arrFaces)
			End If
		Else
			arrMesh(k) = Rhino.addmesh(arrPoints,arrFaces)
		End If
	Next
	If intSteps >< 2 Then
		arrOutput = Rhino.MeshBooleanUnion(arrMesh)
	End If
	bladesFlat = arrOutput
End Function
Function segmentedStem(arrPlane,dblHeight,dblSegments,maxRotation)
	segmentedStem = Null
	Dim i, count
	count = dblSegments-1
	Dim dblStep, tempLen, dblLen()
	Dim mPlane(), tmpAngle(1), blnWavy
	ReDim dblLen(count), mPlane(count+1)

	mPlane(0) = Rhino.RotatePlane(arrPlane,random(0,360),arrPlane(3))
	blnWavy = random(-1,1)

	dblStep = dblHeight/dblSegments
	For i = 0 To count Step 1
		If i = 0 Then
			tempLen = random(0.5,1)*dblStep
			dblLen(i) = dblStep-tempLen
		ElseIf i = count Then
			tempLen = dblStep+dblLen(i-1)
		Else
			tempLen = random(0.5,1)*(dblStep+dblLen(i-1))
			dblLen(i) = dblStep+dblLen(i-1)-tempLen
		End If
		If blnWavy >= 0 Then
			tmpAngle(0) = random(0,maxRotation)
			tmpAngle(1) = random(0,maxRotation)
		Else
			tmpAngle(0) = random(-maxRotation,0)
			tmpAngle(1) = random(-maxRotation,0)
		End If
		mPlane(i+1) = Rhino.RotatePlane(Rhino.RotatePlane(Rhino.moveplane(mPlane(i),Rhino.PointAdd(mPlane(i)(0),Rhino.VectorScale(Rhino.VectorUnitize(mPlane(i)(3)),tempLen))),tmpAngle(0),mPlane(i)(1)),tmpAngle(1),mPlane(i)(2))
	Next
	segmentedStem = mPlane
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
End Function
Function random(min,max)
	random = Null
	Dim dblValue: dblValue = min+(max-min)*rnd()
	random = dblValue
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Friday, October 02, 2009 12:22:08 AM

Call Main()
Sub Main()
	Dim i, j, arrObjects, strType, strMethod, intCount, dblRadius, dblDim(2), arrCircles(), arrPoints()

	intCount = Rhino.GetInteger("Total Number of Points",100,1)
	If isNull(intCount) Then Exit Sub

	strType = Rhino.GetString("Select Geometry Type","Circle",array("Circle","Sphere","Cube","Curve","Surface"))
	If isNull(strType) Then Exit Sub

	If strType = "Circle" Then
		strType = Rhino.GetString("Select Circle Geometry","Object",array("Object","ByOrigin"))
		If isNull(strType) Then Exit Sub
		strMethod = Rhino.GetString("Select Circle Method","Dispersed",array("Dispersed","Radial"))
		If isNull(strMethod) Then Exit Sub

		If strType = "Object" Then
			arrObjects = Rhino.GetObjects("Select Circles",4,,True)
			If isNull(arrObjects) Then Exit Sub
			j=0

			For i = 0 To uBound(arrObjects) Step 1
				If Rhino.IsCircle(arrObjects(i)) Then
					ReDim Preserve arrCircles(j), arrPoints(j)
					arrCircles(j) = arrObjects(i)
					arrPoints(j) = Rhino.CircleCenterPoint(arrCircles(j))
					j = j+1
				End If
			Next
			arrObjects = arrPoints
		Else
			arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
			If isNull(arrObjects) Then Exit Sub
			dblRadius = Rhino.GetReal("Radius",1)
			If isNull(dblRadius) Then Exit Sub
		End If
		Call Rhino.EnableRedraw(False)
		For i = 0 To uBound(arrObjects) Step 1
			If strType = "Object" Then
				dblRadius = Rhino.CircleRadius(arrCircles(i))
			Else
				arrObjects(i) = Rhino.PointCoordinates(arrObjects(i))
			End If
			If strMethod = "Radial" Then
				Call Rhino.AddPointCloud(randomPointCircleRadial(arrObjects(i), dblRadius, intCount))
			Else
				Call Rhino.AddPointCloud(randomPointCircle(arrObjects(i), dblRadius, intCount))
			End If
		Next
		Call Rhino.EnableRedraw(True)
		Exit Sub

	ElseIf strType = "Sphere" Then
		strMethod = Rhino.GetString("Select Sphere Method","Volume",array("Volume","Radial","Shell"))
		If isNull(strMethod) Then Exit Sub
		arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
		If isNull(arrObjects) Then Exit Sub
		dblRadius = Rhino.GetReal("Radius",1)
		If isNull(dblRadius) Then Exit Sub
		Call Rhino.EnableRedraw(False)
		For i = 0 To uBound(arrObjects) Step 1
			If strMethod = "Volume" Then
				Call Rhino.AddPointCloud(randomPointSphere(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
			ElseIf strMethod = "Shell" Then
				Call Rhino.AddPointCloud(randomPointSphereShell(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
			Else
				Call Rhino.AddPointCloud(randomPointSphereVol(Rhino.PointCoordinates(arrObjects(i)), dblRadius, intCount))
			End If
		Next
		Call Rhino.EnableRedraw(True)
		Exit Sub

	ElseIf strType = "Cube" Then
		strMethod = Rhino.GetString("Select Cube Method","Volume",array("Volume","Shell"))
		If isNull(strMethod) Then Exit Sub
		arrObjects = Rhino.GetObjects("Select Origin Points",1,,True)
		If isNull(arrObjects) Then Exit Sub
		dblDim(0) = Rhino.GetReal("Length",1)
		dblDim(1) = Rhino.GetReal("Width",1)
		dblDim(2) = Rhino.GetReal("Height",1)
		Call Rhino.EnableRedraw(False)
		For i = 0 To uBound(arrObjects) Step 1
			If strMethod = "Volume" Then
				Call Rhino.AddPointCloud(randomPointCubeVol(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
			Else
				Call Rhino.AddPointCloud(randomPointCube(Rhino.PointCoordinates(arrObjects(i)), dblDim(0), dblDim(1), dblDim(2), intCount))
			End If
		Next
		Call Rhino.EnableRedraw(True)
		Exit Sub

	ElseIf strType = "Curve" Then
		arrObjects = Rhino.GetObjects("Select Curves",4,,True)
		If isNull(arrObjects) Then Exit Sub
		dblRadius = Rhino.GetReal("Maximum Deviation",1)
		If isNull(dblRadius) Then Exit Sub
		Call Rhino.EnableRedraw(False)
		For i = 0 To uBound(arrObjects) Step 1
			Call reparameterize(arrObjects(i))
			Call Rhino.AddPointCloud(randomPtsCrv(arrObjects(i),dblRadius,intCount))
		Next
		Call Rhino.EnableRedraw(True)
		Exit Sub

	ElseIf strType = "Surface" Then
		arrObjects = Rhino.GetObjects("Select Surfaces",8,,True)
		If isNull(arrObjects) Then Exit Sub
		dblRadius = Rhino.GetReal("Maximum Deviation",1)
		If isNull(dblRadius) Then Exit Sub
		Call Rhino.EnableRedraw(False)
		For i = 0 To uBound(arrObjects) Step 1
			Call reparameterize(arrObjects(i))
			Call Rhino.AddPointCloud(randomPtsSrf(arrObjects(i),dblRadius,intCount))
		Next
		Call Rhino.EnableRedraw(True)
		Exit Sub
	End If

End Sub
Function randomPointCircleRadial(arrOrigin, dblRadius, intCount)
	randomPointCircleRadial = Null
	Dim i, dblRandom(1), arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		dblRandom(0) = random(0,2*PI)
		dblRandom(1) = random(0,dblRadius)
		arrOutput(i) = array(arrOrigin(0)+dblRandom(1)*sin(dblRandom(0)),arrOrigin(1)+dblRandom(1)*cos(dblRandom(0)),arrOrigin(2))
	Next
	randomPointCircleRadial = arrOutput
End Function
Function randomPointCircle(arrOrigin, dblRadius, intCount)
	randomPointCircle = Null
	Dim i, arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		Do
			arrOutput(i) = array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2))

			If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
		Loop
	Next
	randomPointCircle = arrOutput
End Function
Function randomPointSphereShell(arrOrigin, dblRadius, intCount)
	randomPointSphereShell = Null
	Dim i, dblRandom(1), arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		dblRandom(0) = random(0,2*PI)
		dblRandom(1) = random(0,PI)
		arrOutput(i) = array(arrOrigin(0)+dblRadius*sin(dblRandom(0))*sin(dblRandom(1)),arrOrigin(1)+dblRadius*cos(dblRandom(0))*sin(dblRandom(1)),arrOrigin(2)+dblRadius*cos(dblRandom(1)))
	Next
	randomPointSphereShell = arrOutput
End Function
Function randomPointSphere(arrOrigin, dblRadius, intCount)
	randomPointSphere = Null
	Dim i, arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		Do
			arrOutput(i) = array(arrOrigin(0)+random(-dblRadius,dblRadius),arrOrigin(1)+random(-dblRadius,dblRadius),arrOrigin(2)+random(-dblRadius,dblRadius))
			If Rhino.Distance(arrOrigin,arrOutput(i)) < dblRadius Then Exit Do
		Loop
	Next
	randomPointSphere = arrOutput
End Function
Function randomPointSphereVol(arrOrigin, dblRadius, intCount)
	randomPointSphereVol = Null
	Dim i, dblRandom(2), arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		dblRandom(0) = random(0,2*PI)
		dblRandom(1) = random(0,PI)
		dblRandom(2) = random(0,dblRadius)
		arrOutput(i) = array(arrOrigin(0)+dblRandom(2)*sin(dblRandom(0))*sin(dblRandom(1)),arrOrigin(1)+dblRandom(2)*cos(dblRandom(0))*sin(dblRandom(1)),arrOrigin(2)+dblRandom(2)*cos(dblRandom(1)))
	Next
	randomPointSphereVol = arrOutput
End Function
Function randomPointCube(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
	randomPointCube = Null
	Dim i, arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		arrOutput(i) = array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
	Next
	randomPointCube = arrOutput
End Function
Function randomPointCubeVol(arrOrigin, dblLength, dblWidth, dblHeight, intCount)
	randomPointCubeVol = Null
	Dim i, arrOutput()
	ReDim arrOutput(intCount-1)

	For i = 0 To intCount-1 Step 1
		arrOutput(i) = array(arrOrigin(0)+random(0,dblLength),arrOrigin(1)+random(0,dblLength),arrOrigin(2)+random(0,dblHeight))
	Next
	randomPointCubeVol = arrOutput
End Function
Function randomPtsCrv(strCurve,dblDist,intCount)
	randomPtsCrv = Null
	Dim i, tDom, dblRandom, arrOutput()
	ReDim arrOutput(intCount-1)
	tDom = Rhino.CurveDomain(strCurve)

	For i = 0 To intCount-1 Step 1
		dblRandom = random(tDom(0),tDom(1)-tDom(0))
		arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateCurve(strCurve,dblRandom),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.CurvePerpFrame(strCurve,dblRandom)(1)),random(-dblDist,dblDist)))
	Next

	randomPtsCrv = arrOutput
End Function
Function randomPtsSrf(strSurface,dblDist,intCount)
	randomPtsSrf = Null
	Dim i, uDom, vDom, arrOutput()
	ReDim arrOutput(intCount-1)
	uDom = Rhino.SurfaceDomain(strSurface,0)
	vDom = Rhino.SurfaceDomain(strSurface,1)

	For i = 0 To intCount-1 Step 1
		arrOutput(i) = Rhino.PointAdd(Rhino.EvaluateSurface(strSurface,array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1)))),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(strSurface,array(random(uDom(0),uDom(1)),random(vDom(0),vDom(1))))),random(-dblDist,dblDist)))
	Next

	randomPtsSrf = arrOutput
End Function
Function random(min,max)
	random = Null
	Dim dblValue: dblValue = min+(max-min)*rnd()
	random = dblValue
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
End Function

  

---

Developed for optimizing curves for laser cutting files, this script allows the user to rebuild curves that fall within a certain point count range. The user is asked to select a series of curves and is then prompted to select a minimum and maximum point count as well as a point count for rebuilding if the curve falls within these parameters. Additionally the ability to override the degree of curvature is included, if the value is zero the exiting curvature is retained.

---

platform: Rhino Script

function: Modeling Aid

 

---

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Tuesday, June 09, 2009 3:07:42 PM

Call Main()
Sub Main()
    Dim curves, arrValue

    curves = Rhino.GetObjects("Select Curves to Rebuild",4,,True)
    If isNull(curves) Then Exit Sub

    arrValue = Rhino.PropertyListBox(array("Range Minimum","Range Maximum","Point Count","Degree (0=current)"),array(2,10,5,0))
    If isNull(arrValue) Then Exit Sub
    Call Rhino.EnableRedraw(False)
    Call reBuildRange(curves,CInt(arrValue(0)),CInt(arrValue(1)),CInt(arrValue(2)),CInt(arrValue(3)))
    Call Rhino.EnableRedraw(True)

End Sub
Function reBuildRange(arrCurves,minVal,maxVal,dblValue,dblDegree)
    reBuildRange = Null
    Dim i, tVal, tDeg
    Dim arrOutput()
    ReDim arrOutput(uBound(arrCurves))

    For i = 0 To uBound(arrCurves) Step 1
        'find the existing point count, set rebuild to false
        tVal = Rhino.CurvePointCount(arrCurves(i))
        'if the point count is in range then set rebuild to true and specify new point count
        If tVal >= minVal And tVal <= maxVal Then
            'if degree is set to zero use existing curve degree, otherwise specify new curve degree
            If dblDegree <= 0 Then
                tDeg = Rhino.CurveDegree(arrCurves(i))
            Else
                tDeg = dblDegree
            End If
            arrOutput(i) = Rhino.RebuildCurve(arrCurves(i),tDeg,dblValue)
        Else
            arrOutput(i) = arrCurves(i)
        End If
    Next

    reBuildRange = arrOutput
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Tuesday, June 09, 2009 3:07:42 PM

Call Main()
Sub Main()
    Dim curves, arrValue

    curves = Rhino.GetObjects("Select Surfaces to Rebuild",8,,True)
    If isNull(curves) Then Exit Sub

    arrValue = Rhino.PropertyListBox(array("(U) Range Minimum","(U) Range Maximum","(U) Point Count","(U) Degree (0=current)","(V) Range Minimum","(V) Range Maximum ","(V) Point Count","(V) Degree(0=current)"),array(2,10,5,0,2,10,5,0))
    If isNull(arrValue) Then Exit Sub
    Call Rhino.EnableRedraw(False)
    Call reBuildRange(curves,array(CInt(arrValue(0)),CInt(arrValue(4))),array(CInt(arrValue(1)),CInt(arrValue(5))),array(CInt(arrValue(2)),CInt(arrValue(6))),array(CInt(arrValue(3)),CInt(arrValue(7))))
    Call Rhino.EnableRedraw(True)

End Sub
Function reBuildRange(arrSurfaces,minVal,maxVal,arrValue,arrDegree)
    reBuildRange = Null
    Dim i, tVal(1), tDeg(1),tBln(1)
    Dim arrOutput()
    ReDim arrOutput(uBound(arrSurfaces))

    For i = 0 To uBound(arrSurfaces) Step 1
        'calculate for U then V
        For j = 0 To 1 Step 1
            'find the existing point count, set rebuild to false
            tVal(j) = Rhino.SurfacePointCount(arrSurfaces(i))(j)
            tBln(j) = False
            'if the point count is in range then set rebuild to true and specify new point count
            If tVal(j) >= minVal(j) And tVal(j) <= maxVal(j) Then
                tBln(j) = True
                tVal(j) = arrValue(j)
            Else
                tVal(j) = tVal(j)
            End If
            'if degree is set to zero use existing surface degree, otherwise specify new surface degree
            If arrDegree(j) <= 0 Then
                tDeg(j) = Rhino.SurfaceDegree(arrSurfaces(i))(j)
            Else
                tDeg(j) = arrDegree(j)
            End If

        Next
        'if both U and V point counts fall within specified range, rebuild surface
        If tBln(0) = True And tBln(1) = True Then
            arrOutput(i) = Rhino.RebuildSurface (arrSurfaces(i) , tDeg, tVal)
        Else
            arrOutput(i) = arrSurfaces(i)
        End If

    Next

    reBuildRange = arrOutput
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Sunday, May 10, 2009 11:12:11 PM

Call Main()
Sub Main()
	Dim strCurve: strCurve = Rhino.GetObject("Select Origin Rail",4,True)
	If isNull(strCurve) Then Exit Sub
	Call Rhino.LockObject(strCurve)

	Dim arrCurves: arrCurves = Rhino.GetObjects("Select Relative Curves",4,False)
	If isNull(arrCurves) Then Exit Sub
	Call Rhino.LockObjects(arrCurves)

	Dim strRail: strRail = Rhino.GetObject("Select Target Rail",4,False)
	If isNull(strRail) Then Exit Sub

	Dim dblSamples: dblSamples = Rhino.GetInteger("Samples",30,3)
	If isNull(dblSamples) Then Exit Sub

	Call Rhino.UnlockObject(strCurve)
	Call Rhino.UnlockObjects(arrCurves)

	Call Rhino.EnableRedraw(False)
	Call orientCurves(strCurve, strRail, arrCurves, dblSamples)
	Call Rhino.EnableRedraw(True)

End Sub
Function orientCurves(strCurve, strRail, arrCurves, dblSamples)
	orientCurves = Null
	Dim i, j, k
	Dim arrPoint
	Dim cDom(2), dblParam(2), plan(1)
	Dim arrCtrlPt(), arrOutput()
	ReDim arrCtrlPt(dblSamples), arrOutput(uBound(arrCurves))

	cDom(0) = Rhino.CurveDomain(strCurve)
	cDom(2) = Rhino.CurveDomain(strRail)
	For i = 0 To uBound(arrCurves) Step 1
		cDom(1) = Rhino.CurveDomain(arrCurves(i))
		For j = 0 To dblSamples Step 1
			For k = 0 To 2 Step 1
				dblParam(k) = cDom(k)(0)+(cDom(k)(1)-cDom(k)(0))/dblSamples
			Next
			arrPoint = Rhino.EvaluateCurve(arrCurves(i),dblParam(1)*j)

			plan(0) = Rhino.CurvePerpFrame(strCurve,dblParam(0)*j)
			plan(1) = Rhino.CurvePerpFrame(strRail,dblParam(2)*j)

			arrCtrlPt(j) = orientPoint(arrPoint,plan(0),plan(1))
		Next
		arrOutput(i) = Rhino.AddInterpCurve(arrCtrlPt,3)
	Next

	orientCurves = arrOutput
End Function
Function orientPoint(arrPoint,arrOriginPlane,arrTargetPlane)
	orientPoint = Null
	Dim arrOutput, tempPt, arrPoints(3)

	arrPoints(0) = Rhino.PointAdd(arrOriginPlane(0),arrOriginPlane(1))
	arrPoints(1) = Rhino.PointAdd(arrOriginPlane(0),arrOriginPlane(2))
	arrPoints(2) = Rhino.PointAdd(arrTargetPlane(0),arrTargetPlane(1))
	arrPoints(3) = Rhino.PointAdd(arrTargetPlane(0),arrTargetPlane(2))

	tempPt = Rhino.AddPoint(arrPoint)
	Call Rhino.OrientObject(tempPt,array(arrOriginPlane(0),arrPoints(0),arrPoints(1)), array(arrTargetPlane(0),arrPoints(2),arrPoints(3)))

	arrOutput = Rhino.PointCoordinates(tempPt)
	Call Rhino.DeleteObject(tempPt)
	orientPoint = arrOutput
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, October 09, 2008 11:21:36 PM

Call Main()

Sub Main()

	Call arrayRotateAboutCurve()

End Sub
Function arrayRotateAboutCurve()

	arrayRotateAboutCurve = Null

	Dim i,j, objects,angle, originPln, steps, scale, curve, pt(2), dom, crvFrame, rotFrame, rotWav, disWav
	objects = Rhino.GetObjects("Select Objects")
	If isNull(objects) Then Exit Function

	pt(0) = Rhino.GetPoint("Select Origin Point")
	If isNull(pt(0)) Then Exit Function

	pt(2) = Rhino.GetPoint("Select Point for X Axis")
	If isNull(pt(2)) Then Exit Function

	pt(1) = Rhino.GetPoint("Select Point for Y Axis")
	If isNull(pt(1)) Then Exit Function

	originPln = Rhino.PlaneFitFromPoints(pt)
	curve = Rhino.GetObject("Select Curve",4)
	If isNull(curve) Then Exit Function

	Dim arrItems, arrValues, arrResults
	arrItems = array("Steps","End Rotation","Rotational Waves","End Scale","Scalar Waves")
	arrValues = array(10,90,1,0.25,1)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Spiral Settings")

	steps = CDbl(arrResults(0))
	angle = CDbl(arrResults(1))
	rotWav= 1/(CDbl(arrResults(2))*2)
	disWav= 1/(CDbl(arrResults(4))*2)

	If CDbl(arrResults(3)) > 1 Then
		scale = CDbl(arrResults(3))-1
	Else
		scale = 1-CDbl(arrResults(3))
	End If
	Call Rhino.EnableRedraw(False)
	Call rhino.SelectObject(curve)
	Call rhino.Command("reparameterize 0 1")
	Call rhino.UnselectAllObjects()

	dom = Rhino.CurveDomain(curve)(1)

	Dim tmpObj, tmpPnt, dblScale

	For i = 0 To steps Step 1
		crvFrame = Rhino.CurvePerpFrame(curve,(dom/steps)*i)
		rotFrame = Rhino.RotatePlane(crvFrame,angle*Cos(i/(steps*rotWav)*pi),crvFrame(3))

		For j = 0 To uBound(objects) Step 1
			If CDbl(arrResults(3)) < 1 Then
				dblScale = 1-(scale-scale*Cos(i/(steps*disWav)*pi))*0.5
			ElseIf CDbl(arrResults(3)) > 1 Then
				dblScale = 1+(scale-scale*Cos(i/(steps*disWav)*pi))*0.5
			Else
				dblScale = 1
			End If
			tmpObj = Rhino.OrientObject(objects(j),pt,array(rotFrame(0),Rhino.PointAdd(rotFrame(0),rotFrame(1)),Rhino.PointAdd(rotFrame(0),rotFrame(3))),1)
			Call Rhino.ScaleObject(tmpObj,rotFrame(0),array(dblScale,dblScale,dblScale))

		Next
	Next
	Call Rhino.EnableRedraw(True)

End Function

Option Explicit
'Script written by <David Mans>
'adapted from work by Che Wei Wang
'www.cwwang.com
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, March 18, 2008 7:40:18 AM

Call Main()
Sub Main()
	Dim arrObjects: arrObjects = Rhino.GetObjects("Select Objects",,True)
	If isNull(arrObjects) Then Exit Sub

	Dim arrItems, arrValues, arrResults
	arrItems = array("columns","rows","maximum_scale_height")
	arrValues = array(10,10,2)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Image Parameters")

	Dim arrImg

	arrImg = arrImageSample(arrResults(0),arrResults(1))
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance

	Call Rhino.EnableRedraw(False)
	Call scaleByImage(arrObjects,arrImg(6),CDbl(arrResults(2)))
	Call Rhino.DeleteObjects(arrObjects)
	Call Rhino.EnableRedraw(True)

End Sub
Function scaleByImage(arrObjects,arrValues,dblScale)
	scaleByImage = Null
	Dim i, j, x, y, bBox

	bBox = Rhino.BoundingBox(arrObjects)
	x = Rhino.Distance(bBox(0),bBox(1))
	y = Rhino.Distance(bBox(0),bBox(3))

	Dim arrOutput(),tOutput()
	ReDim arrOutput(uBound(arrValues))

	For i = 0 To uBound(arrValues)-1 Step 1
		ReDim tOutput(uBound(arrValues(i)))
		For j = 0 To uBound(arrValues(i))-1 Step 1
			tOutput(j) = Rhino.ScaleObjects(Rhino.CopyObjects(arrObjects,array(0,0,0),array(x*i,y*j,0)),array(0,0,0),array(1,1,1+dblScale*arrValues(i)(j)))
		Next
		arrOutput(j) = tOutput
	Next

	scaleByImage = arrOutput
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function

	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If

	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If

	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)

	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j

			If x>w Then
				x = w
			End If

			If y>h Then
				y = h
			End If

			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)

		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, October 09, 2008 11:21:36 PM

Call Main()

Sub Main()

	Call arrayRotateAboutCurve()

End Sub
Function arrayRotateAboutCurve()

	arrayRotateAboutCurve = Null

	Dim i,j, objects,angle, originPln, steps, scale, curve, pt(2), dom, crvFrame, rotFrame
	objects = Rhino.GetObjects("Select Objects")
	If isNull(objects) Then Exit Function

	pt(0) = Rhino.GetPoint("Select Origin Point")
	If isNull(pt(0)) Then Exit Function

	pt(2) = Rhino.GetPoint("Select Point for X Axis")
	If isNull(pt(2)) Then Exit Function

	pt(1) = Rhino.GetPoint("Select Point for Y Axis")
	If isNull(pt(1)) Then Exit Function

	originPln = Rhino.PlaneFitFromPoints(pt)
	curve = Rhino.GetObject("Select Curve",4)
	If isNull(curve) Then Exit Function

	Dim arrItems, arrValues, arrResults
	arrItems = array("Steps","End Rotation","End Scale")
	arrValues = array(10,360,0.25)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Spiral Settings")

	steps = CDbl(arrResults(0))
	angle = CDbl(arrResults(1))/CDbl(arrResults(0))

	If CDbl(arrResults(2)) > 1 Then
		scale = CDbl(arrResults(2))-1
	Else
		scale = 1-CDbl(arrResults(2))
	End If
	Call Rhino.EnableRedraw(False)
	Call rhino.SelectObject(curve)
	Call rhino.Command("reparameterize 0 1")
	Call rhino.UnselectAllObjects()

	dom = Rhino.CurveDomain(curve)(1)

	Dim tmpObj, tmpPnt, dblScale

	For i = 0 To steps Step 1
		crvFrame = Rhino.CurvePerpFrame(curve,(dom/steps)*i)
		rotFrame = Rhino.RotatePlane(crvFrame,angle*i,crvFrame(3))

		For j = 0 To uBound(objects) Step 1
			tmpObj = Rhino.OrientObject(objects(j),pt,array(rotFrame(0),Rhino.PointAdd(rotFrame(0),rotFrame(1)),Rhino.PointAdd(rotFrame(0),rotFrame(3))),1)

			If CDbl(arrResults(2)) < 1 Then
				dblScale = 1-(scale/steps)*i
			ElseIf CDbl(arrResults(2)) > 1 Then
				dblScale = 1+(scale/steps)*i
			Else
				dblScale = 1
			End If

			Call Rhino.ScaleObject(tmpObj,rotFrame(0),array(dblScale,dblScale,dblScale))

		Next
	Next
	Call Rhino.EnableRedraw(True)

End Function

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

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

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Sunday, May 25, 2008 11:21:36 PM
Private aA,aB,aC,aD,aE,aF
Call Main()
Sub Main()
	Dim curve
	curve = Rhino.GetObject("Select Curve",4)
	If isNull(curve) Then Exit Sub

	If IsEmpty(aF) Then
		aF = 2
	End If
	If IsEmpty(aA) Then
		aA = 20
	End If
	If IsEmpty(aB) Then
		aB = 2
	End If
	If IsEmpty(aC) Then
		aC = 3
	End If
	If IsEmpty(aD) Then
		aD = 90
	End If
	If IsEmpty(aE) Then
		aE = 90
	End If

	Dim b, arrItems, arrValues
	arrItems = array("waves","steps","baseLength","increaseLength","baseRotation","increaseRotation")
	arrValues= array(aF,aA,aB,aC,aD,aE)
	b = Rhino.PropertyListBox (arrItems, arrValues ,,"Volume Parameters")

	aA = CDbl(b(1)): aB = CDbl(b(2)): aC = CDbl(b(3)): aD = CDbl(b(4)): aE = CDbl(b(5)): aF = CStr(b(0))

	Call reparameterize(curve)
	Call Rhino.EnableRedraw(False)
	Call quickStems(curve,aA-1,aB,aC,aD,aE*.5,aF)
	Call Rhino.EnableRedraw(True)

End Sub
Function quickStems(curve,steps,bLen,length,bRot,rotation,waves)
	quickStems = Null
	Dim i
	Dim crvDom, ori, pln, plnR, len, rot, vect, wav
	Dim finCrv
	ReDim crv(steps),pt(steps)
	crvDom = Rhino.CurveDomain(curve)
	wav = 1/waves
	For i = 0 To steps Step 1
		len = length-length*Cos(i/(steps*wav)*pi)
		rot = rotation-rotation*Cos(i/(steps*wav)*pi)
		ori = Rhino.EvaluateCurve(curve,crvDom(1)/steps*i)
		pln = Rhino.CurvePerpFrame (curve,crvDom(1)/steps*i)

		plnR= Rhino.RotatePlane(pln,rot-brot,pln(3))
		vect= Rhino.PointAdd(ori,Rhino.VectorScale(Rhino.VectorUnitize(plnR(2)),bLen+len))

		pt(i) = vect
	Next
	finCrv = Rhino.AddInterpCurve(pt)
	Call Rhino.AddLoftSrf(array(finCrv,curve))
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1")
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1")
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Thursday, March 13, 2008 4:36:59 PM

Call Main()
Sub Main()
	Dim rails,profile,blnOrigin, i
	rails = Rhino.GetObjects("Select Rail Curves",4)
	If isNull(rails) Then Exit Sub
	profile = Rhino.GetObjects("Select Profile Curves in Order of Placement",4)
	If isNull(profile) Then Exit Sub

	Dim bbox, tline, tpt, pt, arrPt()
	ReDim arrPt(Ubound(profile))
		For i = 0 To Ubound(profile) Step 1
			Call Rhino.SelectObject(profile(i))
			bbox = Rhino.BoundingBox(profile(i))
			Call Rhino.EnableRedraw(False)
			tline = Rhino.AddLine(bbox(0),bbox(2))
			tpt = Rhino.CurveMidPoint(tline)
			Call Rhino.DeleteObject(tline)
			Call Rhino.EnableRedraw(True)

			pt = Rhino.GetPoint("Select Origin for Profile" & i,tpt)
			Call Rhino.Command("_SelNone",False)

			If isNull(pt) Then
				arrPt(i) = tpt
			Else
				arrPt(i) = pt
			End If
			pt = Null
		Next

	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(rails) Step 1
		Call reparameterize(rails(i))
	Next
	Call Rhino.EnableRedraw(True)

	Call curveSweepMultiProf(rails,profile,arrPt)
End Sub
Function curveSweepMultiProf(rail,profile,arrOrigin)
	curveSweepMultiProf = Null

	Dim i,j,k,m,n,angle,pCount,Count
	Count = uBound(rail)
	pCount = uBound(profile)
	'profile variables
	Dim bBox(), oriPts(), dist(2), originPts(2),originPln
	ReDim bBox(pCount), oriPts(pCount)

	'create an origin plane for the profile
	Call Rhino.EnableRedraw(False)
	For j = 0 To pCount Step 1
		bBox(j) = Rhino.BoundingBox(profile(j))
		dist(0) = Rhino.Distance(bBox(j)(0),bBox(j)(2))
		dist(1) = Rhino.Distance(bBox(j)(0),bBox(j)(5))
		dist(2) = Rhino.Distance(bBox(j)(0),bBox(j)(7))

		If dist(0) > dist(1) And dist(0) > dist(2) Then
			m = array(1,0,0)
			n = array(0,1,0)
		ElseIf dist(1) > dist(0) And dist(1) > dist(2) Then
			m = array(1,0,0)
			n = array(0,0,1)
		ElseIf dist(2) > dist(1) And dist(2) > dist(0) Then
			m = array(0,1,0)
			n = array(0,0,1)
		End If

		originPts(2)= arrOrigin(j)
		originPts(0)= array(originPts(2)(0)+m(0),originPts(2)(1)+m(1),originPts(2)(2)+m(2))
		originPts(1)= array(originPts(2)(0)+n(0),originPts(2)(1)+n(1),originPts(2)(2)+n(2))

		originPln = Rhino.PlaneFromPoints(originPts(2),originPts(0),originPts(1))
		oriPts(j) = originPts
	Next

	'create alignment planes on the curve
	'rail variables
	Dim crvDom,crvStep, crvPlane(),crvProf(),crvPt(2)
	ReDim crvPlane(Pcount),crvPlaneSet(count),crvProfSet(count),crvProf(Pcount)
	For i = 0 To count Step 1
		crvDom = Rhino.CurveDomain(rail(i))
		If Pcount = 0 Then
			crvStep= 0
		Else
			crvStep= crvDom(1)/Pcount
		End If
		For j = 0 To Pcount Step 1
			crvPlane(j) = Rhino.CurvePerpFrame(rail(i), j*crvStep)
			crvPt(0) = crvPlane(j)(0)
			crvPt(1) = Rhino.pointadd(crvPlane(j)(0),crvPlane(j)(1))
			crvPt(2) = Rhino.pointadd(crvPlane(j)(0),crvPlane(j)(2))
			crvProf(j) = Rhino.OrientObject (profile(j), array(oriPts(j)(2),oriPts(j)(1),oriPts(j)(0)),array(crvPt(0),crvPt(1),crvPt(2)),1)
		Next
		crvPlaneSet(i)= crvPlane
		crvProfSet(i) = crvProf
	Next
	'allow for rotation correction
	Call Rhino.EnableRedraw(True)
	angle = 90
	Do Until angle = 0
		angle = Rhino.GetReal("Object Rotation",0,0,360)
		If isNull(angle) Then Exit Do
		Call Rhino.EnableRedraw(False)
		For i = 0 To count Step 1
			For j = 0 To Pcount Step 1
				Call Rhino.RotateObject(crvProfSet(i)(j),crvPlaneSet(i)(j)(0),angle,crvPlaneSet(i)(j)(3))
			Next
		Next
		Call Rhino.EnableRedraw(True)
	Loop

	Call Rhino.EnableRedraw(False)

	'sweep variables
	Dim swProfSet(),strProfSet
	ReDim swProfSet(Pcount)

	'call out sweep command
	For i = 0 To count Step 1
		For j = 0 To Pcount Step 1
			swProfSet(j) = ("_SelID " & crvProfSet(i)(j) & " ")
		Next
		strProfSet = Join(swProfSet)
		'swPprofSet
		Call Rhino.Command( "-_Sweep1 " & "_SelID " & rail(i) & " " & strProfSet & " _Enter _Enter _Simplify=None Enter", False)
	Next
	Call Rhino.EnableRedraw(True)

	curveSweepMultiProf = array()
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1",False)
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Saturday, November 29, 2008 7:33:23 PM

Call Main()
Sub Main()
	Dim text, typ, arrValues

	text = Rhino.GetObjects("Select Text",,,True)
	If isNull(text) Then Exit Sub

	arrValues = array("BottomLeft","BottomCenter","BottomRight","MiddleLeft","MiddleCenter","MiddleRight","TopLeft","TopCenter","TopRight")
	typ = Rhino.GetString("Anchor To","BottomLeft",arrValues)
	If isNull(typ) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Dim i, r, s, t, bbox, pt, point

	For i = 0 To 8 Step 1
		If typ = arrValues(i) Then
			r = i
		End If
	Next
	s = 0
	Do While Rhino.IsGroup("txt" & s) = True
		s = s+1
	Loop

	For i = 0 To uBound(text) Step 1
		If Rhino.IsText(text(i)) = True Then
			bbox = Rhino.BoundingBox(text(i))
			If r = 0 Then
				pt = bbox(0)
			ElseIf r = 1 Then
				pt = midPoint(bbox(0),bbox(1))
			ElseIf r = 2 Then
				pt = bbox(1)
			ElseIf r = 3 Then
				pt = midPoint(bbox(0),bbox(3))
			ElseIf r = 4 Then
				pt = midPoint(bbox(0),bbox(2))
			ElseIf r = 5 Then
				pt = midPoint(bbox(1),bbox(2))
			ElseIf r = 6 Then
				pt = bbox(3)
			ElseIf r = 7 Then
				pt = midPoint(bbox(3),bbox(2))
			ElseIf r = 8 Then
				pt = bbox(2)
			End If
			point = Rhino.AddPoint(pt)
			Call Rhino.AddGroup("txt" & i+s)
			Call Rhino.AddObjectsToGroup(array(text(i),point),"txt" & i+s)
		End If
	Next
	Call Rhino.EnableRedraw(True)

End Sub
Function midPoint(ptA,ptB)
	midPoint = Null
	Dim pt, tmpLn
	tmpLn = Rhino.AddLine(ptA,ptB)
	pt = Rhino.CurveMidPoint(tmpLn)
	Call Rhino.DeleteObject(tmpLn)
	midPoint = pt
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Thursday, April 10, 2008 11:13:06 PM

Call Main()
Sub Main()
	Dim objects
	objects = Rhino.GetObjects("Select Objects")
	If isNull(objects) Then Exit Sub
	Call Rhino.enableredraw(False)
	transformEach(objects)
	Call Rhino.enableredraw(True)
End Sub
Function transformEach(objects)
	transformEach = Null
	Dim arrItems, arrValues, arrReturns
	arrItems = array("rotate_X","rotate_Y","rotate_Z","scale_X","scale_Y","scale_Z")
	arrValues= array(0,0,0,1,1,1)
	arrReturns = Rhino.PropertyListBox (arrItems, arrValues ,,"Transform Parameters")
	If isNull(arrReturns) Then Exit Function
	Dim i,count
	Dim bBox,tempLn,origin,world
	count = uBound(objects)
	For i = 0 To count Step 1
		'determine each objects center
		bBox = Rhino.BoundingBox(objects(i))
		tempLn=Rhino.AddLine(bBox(0),bBox(6))
		origin=Rhino.CurveMidPoint(tempLn)
		world = Rhino.WorldXYPlane()
		'if scale values have been changed scale each object according to each of the three independent world axis
		If arrReturns(3) <> 0 Or arrReturns(4) <> 0 Or arrReturns(5) <> 0  Then
			Call Rhino.ScaleObject(objects(i),origin,array(CDbl(arrReturns(3)),CDbl(arrReturns(4)),CDbl(arrReturns(5))))
		End If
		'if rotation values have been changed rotate each object about its local world based axis
		If arrReturns(0) <> 0 Then
			Call Rhino.RotateObject(objects(i),origin,CDbl(arrReturns(0)),world(1))
		End If
		If arrReturns(1) <> 0 Then
			Call Rhino.RotateObject(objects(i),origin,CDbl(arrReturns(1)),world(2))
		End If
		If arrReturns(2) <> 0 Then
			Call Rhino.RotateObject(objects(i),origin,CDbl(arrReturns(2)),world(3))
		End If

		Call Rhino.DeleteObject(tempLn)
	Next
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Wednesday, September 16, 2009 4:56:53 PM

Call Main()
Sub Main()
	Dim arrPtset, arrMode, arrOrient
	arrPtset = Rhino.GetObjects("Select Points to Visualize",1,,True,False)
	If isNull(arrPtset) Then Exit Sub

	arrMode = Rhino.GetString("Select Visualization Mode","Box",array("Circle","Sphere","Cross","Coordinate_System","Box"))
	If isNull(arrMode) Then Exit Sub
	arrOrient = Rhino.GetString("Select Object Orientation","World",array("World", "Active", "Point", "Camera"))
	If isNull(arrOrient) Then Exit Sub

	'Optional Inputs
	Dim arrUserPt, dblRadius, arrCS
	If arrOrient = "Point" Then
		arrUserPt = Rhino.GetPoint("Select Point to Orient Objects Towards",array(0,0,0))
	ElseIf arrOrient = "Camera" Then
		arrUserPt = Rhino.ViewCamera ()
	End If
	If arrOrient = "World" Then
		arrCS = Rhino.GetString("World Coordinate System","XY",array("XY","YZ","ZX"))
	End If

	dblRadius = Rhino.GetReal("Radius",1)
	If isNull(dblRadius) Then Exit Sub

	'Evalute for Each Point
	Dim i, j, arrPt, arrPln, tpt(), v(2), x, y, z

	If arrMode = "Box" Then
		ReDim tPt(7)
		x = array(1,-1,-1,1,1,-1,-1,1)
		y = array(1,1,-1,-1,1,1,-1,-1)
		z = array(-1,-1,-1,-1,1,1,1,1)
	ElseIf arrMode = "Cross" Then
		ReDim tPt(5)
		x = array(1,-1,0,0,0,0)
		y = array(0,0,1,-1,0,0)
		z = array(0,0,0,0,1,-1)
	ElseIf arrMode = "Coordinate_System" Then
		ReDim tPt(5)
		x = array(-1,0,0,0,0,0)
		y = array(0,0,-1,0,0,0)
		z = array(0,0,0,0,-1,0)
	End If
	Call Rhino.EnableRedraw(False)
	For i = 0 To uBound(arrPtset) Step 1
		arrPt = Rhino.PointCoordinates(arrPtset(i))
		'Set up orientation options
		If arrOrient = "World" Then
			If arrCS = "XY" Then
				arrPln = Rhino.MovePlane(Rhino.WorldXYPlane(),arrPt)
			ElseIf arrCS = "YZ" Then
				arrPln = Rhino.MovePlane(Rhino.WorldYZPlane(),arrPt)
			ElseIf arrCS = "ZX" Then
				arrPln = Rhino.MovePlane(Rhino.WorldZXPlane(),arrPt)
			End If
		ElseIf arrOrient = "Active" Then
			arrPln = Rhino.ViewCPlane ()
		ElseIf arrOrient = "Point" Then
			arrPln = Rhino.PlaneFromNormal (arrPt, Rhino.VectorCreate(arrPt,arrUserPt))
		ElseIf arrOrient = "Camera" Then
			arrPln = Rhino.PlaneFromNormal (arrPt, Rhino.VectorCreate(arrPt,arrUserPt))
		End If

		'Execute Visualization Functions/ Geometry
		If arrMode = "Circle" Then
			Call Rhino.AddCircle(arrPln,dblRadius)
		ElseIf arrMode = "Sphere" Then
			Call Rhino.AddSphere(arrPt,dblRadius)
		ElseIf arrMode = "Box" Then
			For j = 0 To 7 Step 1
				tPt(j) = evaluatePlane(arrPln,array(dblRadius*x(j),dblRadius*y(j),dblRadius*z(j)))
			Next
			Call Rhino.AddBox(tPt)
		ElseIf arrMode = "Cross" Or arrMode = "Coordinate_System" Then
			For j = 0 To 4 Step 2
				tPt(j) = evaluatePlane(arrPln,array(dblRadius*x(j),dblRadius*y(j),dblRadius*z(j)))
				tPt(j+1) = evaluatePlane(arrPln,array(dblRadius*x(j+1),dblRadius*y(j+1),dblRadius*z(j+1)))
				Call Rhino.AddLine(tPt(j),tPt(j+1))
			Next
		End If
	Next

	Call Rhino.EnableRedraw(True)
End Sub
Function evaluatePlane(arrPlane, arrPoint)
	evaluatePlane = Null
	Dim i, arrPt
	arrPt = arrPlane(0)
	For i = 0 To 2 Step 1
		arrPt = Rhino.PointAdd(arrPt,Rhino.VectorScale(Rhino.VectorUnitize(arrPlane(i+1)),arrPoint(i)))
	Next

	evaluatePlane = arrPt
End Function

This Rhino Script uses a simple repeating over/under pattern, however this curves in this series run diagonally across the surface creating a pseudo diagrid pattern.

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Saturday, October 04, 2008 7:52:05 PM

Call Main()
Sub Main()
	Dim surface, weave, arrItems, arrValues, arrResults

	surface = Rhino.GetObject("Select Surface",8)
	If isNull(surface) Then Exit Sub
	Call reparameterize(surface)

	arrItems = array("Warp Strands","Weft Strands","Depth")
	arrValues = array(10,10,0.5)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Weave Settings")
	If isNull(arrResults) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	weave = crossWeave(surface,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)))
	Call Rhino.EnableRedraw(True)

End Sub
Function crossWeave(surface,cols,rows,depth)
	crossWeave = Null
	cols = cols*2
	rows = rows*2
	Dim i, j, r, s, count, uDom, vDom, origin, srfNorm,crvCount
	crvCount = cols*0.5+rows*0.5-1
	Dim boolVal(), blnVal(), normal(1),norm(),nrm(),crvs(),xcrvs()
	ReDim boolVal(rows), blnVal(cols)
	ReDim norm(rows),nrm(cols),crvs(crvCount),xcrvs(crvCount)
	uDom = Rhino.SurfaceDomain(surface,0)(1)
	vDom = Rhino.SurfaceDomain(surface,1)(1)

	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			boolVal(j) = array(0,1)
			origin = array(uDom/(cols)*i,vDom/(rows)*j)
			srfNorm = Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,origin)),depth)

			normal(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),srfNorm)
			normal(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,origin),Rhino.VectorReverse(srfNorm))
			norm(j) = normal

		Next
		blnVal(i) = boolVal
		nrm(i) = norm
	Next

	Dim ptA(),ptB(),ptC(),ptD()
	If cols>rows Then
		count = cols
	Else
		count = rows
	End If

	s=0
	For i = 1 To count Step 1
		r=0
		ReDim ptA(0), ptB(0)
		If i Mod(2) Then
			If cols > rows Then
				If i < rows Then
					For j = 0 To i Step 1
						ReDim Preserve ptA(r)
						blnVal(j)(i-j) = flipMe(r+1)
						ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
						r=r+1
					Next
					crvs(s) = Rhino.AddInterpCurve(ptA)
					r=0
					For j = 0 To rows-i Step 1
						ReDim Preserve ptB(r)
						blnVal(cols-rows+i+j)(rows-j) = flipMe(r)
						ptB(r) = nrm(cols-rows+i+j)(rows-j)(blnVal(cols-rows+i+j)(rows-j)(0))
						r=r+1
					Next
					crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
					s=s+1
				Else
					For j = 0 To rows Step 1
						ReDim Preserve ptA(r)
						blnVal(i-rows+j)(rows-j) = flipMe(r)
						ptA(r) = nrm(i-rows+j)(rows-j)(blnVal(i-rows+j)(rows-j)(0))
						r=r+1
					Next
					crvs(s) = Rhino.AddInterpCurve(ptA)
					s=s+1
				End If
			ElseIf rows > cols Then
				If i < cols Then
					For j = 0 To i Step 1
						ReDim Preserve ptA(r)
						blnVal(j)(i-j) = flipMe(r)
						ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
						r=r+1
					Next
					crvs(s) = Rhino.AddInterpCurve(ptA)
					r=0
					For j = 0 To cols-i Step 1
						ReDim Preserve ptB(r)
						blnVal(i+j)(rows-j) = flipMe(r+1)
						ptB(r) = nrm(i+j)(rows-j)(blnVal(i+j)(rows-j)(0))
						r=r+1
					Next
					crvs(rows*0.5+s) = Rhino.AddInterpCurve(ptB)
					s=s+1
				Else
					For j = 0 To cols Step 1
						ReDim Preserve ptA(r)
						blnVal(j)(i-j) = flipMe(r)
						ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
						r=r+1
					Next
					crvs(s) = Rhino.AddInterpCurve(ptA)
					s=s+1
				End If
			Else
				'If they are equal
				For j = 0 To i Step 1
					ReDim Preserve ptA(r)
					blnVal(j)(i-j) = flipMe(r)
					ptA(r) = nrm(j)(i-j)(blnVal(j)(i-j)(0))
					r=r+1
				Next
				r=0
				For j = 0 To cols-i Step 1
					ReDim Preserve  ptB(r)
					blnVal(i+j)(cols-j) = flipMe(r+1)
					ptB(r) = nrm(i+j)(cols-j)(blnVal(i+j)(cols-j)(0))
					r=r+1
				Next
				crvs(s) = Rhino.AddInterpCurve(ptA)
				crvs(cols*0.5+s) = Rhino.AddInterpCurve(ptB)
				s=s+1
			End If
		End If
	Next

	s=0
	For i = 1 To count Step 1
		r=0
		ReDim ptC(0), ptD(0)
		If i Mod(2) Then
			If cols > rows Then
				If i < rows Then
					For j = 0 To i Step 1
						ReDim Preserve ptC(r), ptD(r)
						ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
						ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
						r=r+1
					Next
					xcrvs(s) = Rhino.AddInterpCurve(ptD)
					s=s+1
					xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
				Else
					r=0
					For j = 0 To rows Step 1
						ReDim Preserve ptC(r)
						ptC(r) = nrm(i-rows+j)(j)(blnVal(i-rows+j)(j)(1))
						r=r+1
					Next
					xcrvs(s) = Rhino.AddInterpCurve(ptC)
					s=s+1
				End If
			ElseIf rows > cols Then
				If i < cols Then
					For j = 0 To i Step 1
						ReDim Preserve ptC(r), ptD(r)
						ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
						ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
						r=r+1
					Next
					xcrvs(s) = Rhino.AddInterpCurve(ptD)
					s=s+1
					xcrvs(cols*0.5+rows*0.5-s) = Rhino.AddInterpCurve(ptC)
				Else
					r=0
					For j = 0 To cols Step 1
						ReDim Preserve ptC(r)
						ptC(r) = nrm(j)(i-cols+j)(blnVal(j)(i-cols+j)(1))
						r=r+1
					Next
					s=s+1
					xcrvs(rows*0.5+cols*0.5-s) = Rhino.AddInterpCurve(ptC)
				End If
			Else
				For j = 0 To i Step 1
					ReDim Preserve ptC(r),ptD(r)
					ptC(r) = nrm(cols-i+j)(j)(blnVal(cols-i+j)(j)(1))
					ptD(r) = nrm(j)(rows-i+j)(blnVal(j)(rows-i+j)(1))
					r=r+1
				Next
				xcrvs(cols-1-s) = Rhino.AddInterpCurve(ptC)
				xcrvs(s) = Rhino.AddInterpCurve(ptD)
				s=s+1
			End If
		End If
	Next

	crossWeave = array()
End Function
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 flipMe(input)
	flipMe = Null
	Dim output(1)
	If input Mod(2) Then
		output(0) = 0
		output(1) = 1
	Else
		output(0) = 1
		output(1) = 0
	End If
	flipMe = output
End Function

Well, I finally made one. Ive been putting it off for a while, because so many of them already exist, but it provided the opportunity to look at information sorting in a more streamlined pattern. This Rib fabrication Rhino script allows the user to select a surface, input the row and column count, specify the rib dimensions, then sit back, have a coffee and let the computer do the work.

Option Explicit
'Script written by <David Mans>
'Adapted from concepts provided Andrew Payne of Lift Architects
'http://www.liftarchitects.com/
'Script adapted by <Neoarchaic Studio>
'Script version Thursday, April 02, 2009 12:47:23 AM

Call Main()
Sub Main()
	Dim surface, arrValue
	surface = Rhino.GetObject("Select Surface",8,True)
	If isNull(surface) Then Exit Sub
	Call reparameterize(surface)

	arrValue = Rhino.PropertyListBox(array("Columns","Rows","Rib Height","Rib Width","Tile Spacing","textHeight"),array(10,10,1,0.2,1,0.25))
	If isNull(arrValue) Then Exit Sub

	Call Rhino.EnableRedraw(False)
	Dim bBox: bBox = Rhino.BoundingBox(surface)
	Dim dist: dist = Rhino.Distance(bBox(0),bBox(4))

	Dim grid, ribs, draw
	grid = projectGrid(surface,CInt(arrValue(0)),CInt(arrValue(1)))
	ribs = makeRib(grid,CDbl(arrValue(2)),CDbl(arrValue(3)),dist)
	draw = makeDrawing(ribs(1),CDbl(arrValue(4)),CDbl(arrValue(5)))
	Call Rhino.DeleteObjects(grid(0))
	Call Rhino.DeleteObjects(grid(1))

	Call Rhino.EnableRedraw(True)
End Sub
Function projectGrid(surface,cols,rows)
	projectGrid = Null
	Dim i,j,k,r,s
	Dim bBox, order, edge(3)
	Dim tCrv,crv(1),pCrv(),arrCrv,dom(1), cStp(1)

	bBox = Rhino.BoundingBox(surface)
	order = array(4,5,7,6,4,7,5,6)

	r=0
	For i = 0 To 3 Step 1
		edge(i) = Rhino.AddLine(bBox(order(r)),bBox(order(r+1)))
		r = r+2
	Next
	order = array(cols,rows)
	r=0
	For i = 0 To 1 Step 1
		s=0
		dom(0) = Rhino.CurveDomain(edge(r))
		dom(1) = Rhino.CurveDomain(edge(r+1))
		cStp(0) = (dom(0)(1)-dom(0)(0))/order(i)
		cStp(1) = (dom(1)(1)-dom(1)(0))/order(i)
		For j = 0 To order(i)-1 Step 1
			tCrv = Rhino.AddLine(Rhino.EvaluateCurve(edge(r),dom(0)(0)+cStp(0)*0.5+cStp(0)*j),Rhino.EvaluateCurve(edge(r+1),dom(1)(0)+cStp(1)*0.5+cStp(1)*j))
			arrCrv = Rhino.ProjectCurveToSurface(tCrv,surface,Rhino.VectorReverse(Rhino.WorldXYPlane()(3)))
			Call Rhino.DeleteObject(tCrv)
			For k = 0 To uBound(arrCrv) Step 1
				ReDim Preserve pCrv(s)
				pCrv(s) = arrCrv(k)
				s = s+1
			Next
		Next
		crv(i) = pCrv
		r=r+2
	Next
	Call Rhino.DeleteObjects(edge)
	projectGrid = crv
End Function
Function makeRib(curves,height,width,zHeight)
	makeRib = Null
	Dim i,j,k,r
	Dim intersect, tPt
	Dim arrObject()
	Dim blnBlock, xVal, yVal, zVal, tPts(7)

	xVal = array(-width*0.5,-width*0.5,width*0.5,width*0.5)
	yVal = array(-width*0.5,width*0.5,width*0.5,-width*0.5)
	zVal = array(0,height*2+zHeight)
	r=0
	For i = 0 To 1 Step 1
		For j = 0 To 3 Step 1
			tPts(r) = array(xVal(j),yVal(j),zVal(i))
			r=r+1
		Next
	Next
	blnBlock = Rhino.AddBox(tPts)

	r=0
	For i = 0 To uBound(curves(0)) Step 1
		For j = 0 To uBound(curves(1)) Step 1
			intersect = Rhino.CurveCurveIntersection(curves(0)(i),curves(1)(j))
			If isNull(intersect) Then
			Else
				ReDim Preserve arrObject(r)
				tPt = intersect(0,1)
				arrObject(r) = Rhino.CopyObject(blnBlock,array(0,0,0),tPt)
				r=r+1
			End If
		Next
	Next

	Dim tRib, rib(), tCurve()
	Dim ribSet(1), cutRibs(1),tLine(1),ribCurve(1)

	tLine(0) = Rhino.AddLine(array(0,0,0), array(width,0,0))
	tLine(1) = Rhino.AddLine(array(0,0,0), array(0,width,0))

	For i = 0 To 1 Step 1
		ReDim rib(uBOund(curves(i)))
		For j = 0 To uBOund(curves(i)) Step 1
			Call Rhino.AddTextDot(i & "-" & j,Rhino.CurveEndPoint(curves(i)(j)))
			tRib = Rhino.ExtrudeCurveStraight(curves(i)(j),array(0,0,0),array(0,0,height))
			Call Rhino.MoveObject(tRib,Rhino.CurveEndPoint(tLine(i)),Rhino.CurveMidPoint(tLine(i)))
			rib(j) = Rhino.ExtrudeSurface(tRib,tLine(i))
			Call Rhino.DeleteObject(tRib)
		Next
		ribSet(i) = rib
	Next

	For i = 0 To 1 Step 1
		ReDim tCurve(uBound(ribSet(i)))
		If i = 0 Then
			Call Rhino.MoveObjects(arrObject,array(0,0,0),array(0,0,height*0.5))
		Else
			Call Rhino.MoveObjects(arrObject,array(0,0,0),array(0,0,-height*2-zHeight))
		End If
		cutRibs(i) = Rhino.BooleanDifference(ribSet(i),arrObject,False)
		For j = 0 To ubound(cutRibs(i)) Step 1
			tCurve(j) = Rhino.ProjectCurveToSurface(curves(i)(j),cutRibs(i)(j),Rhino.VectorReverse(Rhino.WorldXYPlane()(3)))(0)
		Next
		ribCurve(i) = tCurve
		Call Rhino.DeleteObjects(ribSet(i))
	Next

	Call Rhino.DeleteObjects(arrObject)
	Call Rhino.DeleteObjects(tLine)
	Call Rhino.DeleteObject(blnBlock)
	makeRib = array(cutRibs,ribCurve)
End Function
Function makeDrawing(arrCrvs,spacing,tHeight)
	makeDrawing = Null
	Dim i,j
	Dim cPlane, wPlane, bBox, tObject(), objects()
	ReDim objects(uBOund(arrCrvs))

	Dim pPt, tPt
	Dim xPos, yPos, tPos, ySet()

	For i = 0 To uBound(arrCrvs) Step 1
		ReDim tObject(uBound(arrCrvs(i)))
		For j = 0 To uBound(arrCrvs(i)) Step 1
			cPlane = Rhino.CurvePlane(arrCrvs(i)(j))
			wPlane = Rhino.WorldXYPlane()
			tObject(j) = Rhino.OrientObject(arrCrvs(i)(j),array(cPlane(0),Rhino.PointAdd(cPlane(0),cPlane(1)),Rhino.PointAdd(cPlane(0),cPlane(2))),array(wPlane(0),wPlane(1),wPlane(2)))
			bBox = Rhino.BoundingBox(tObject(j))
			Call Rhino.MoveObject(tObject(j),bBox(0),array(0,0,0))
		Next
		objects(i) = tObject
	Next
	yPos = 0
	For i = 0 To uBound(arrCrvs) Step 1
		tPos = 0
		xPos = 0
		ReDim ySet(uBound(arrCrvs(i)))
		For j = 0 To uBound(arrCrvs(i)) Step 1
			bBox = Rhino.BoundingBox(objects(i)(j))
			pPt = array(xPos,yPos,0)
			If j > 0 Then
				tPos = xPos
				xPos = tPos+Rhino.Distance(bBox(0),bBox(1))+spacing
			Else
				xPos = bBox(1)(0)+spacing
			End If
			Call Rhino.MoveObject(objects(i)(j),bBox(0),pPt)
			Call Rhino.AddText(i & "-" & j,Rhino.CurveStartPoint(objects(i)(j)),tHeight)
			ySet(j) = bBox(2)(1)
		Next
		yPos = Rhino.Max(ySet)+spacing
	Next
End Function
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

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Monday, May 26, 2008 1:43:26 PM

Call Main()
Sub Main()
	Dim surf
	surf = Rhino.GetObject("select surface",8)
	If isNull(surf) Then Exit Sub
	Call reparameterize(surf)

	Dim arrItems, arrValues, arrResults
	arrItems = array("Cell_Colums","Cell_Rows","Offset","Scale_btw_0-1","tabHeight","cutTemplate","surfaces","imageScale","imageOculi")
	arrValues= array(10,10,1,0.4,1,True,True,False,True)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Volume Parameters")
	Dim scale, oculi

	If CBool(arrResults(7)) = True Then
		scale = arrImageSample(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1)(6)
	Else
		scale = arrayValue(CInt(arrResults(0))*2+1, CInt(arrResults(1))*2+1,CDbl(arrResults(2)))
	End If
	If CBool(arrResults(8)) = True Then
		oculi = arrImageSample(CInt(arrResults(0))*2, CInt(arrResults(1))*2)(6)
	Else
		oculi = arrayValue(CInt(arrResults(0))*2, CInt(arrResults(1))*2,CDbl(arrResults(3)))
	End If

	Dim tri, cut(2)
	Call Rhino.EnableRedraw(False)
	tri = TriangulateSurface(surf,CInt(arrResults(0))*2,CInt(arrResults(1))*2,CDbl(arrResults(2)),scale)
	If CBool(arrResults(6)) = True Then
		Call SurfaceMe(tri(0),oculi,CDbl(arrResults(3)),"surfaces_out")
		Call SurfaceMe(tri(1),oculi,CDbl(arrResults(3)),"surfaces_in")
		Call SurfaceMe(tri(2),oculi,CDbl(arrResults(3)),"surfaces_center")
	End If

	If CBool(arrResults(5)) = True Then
		cut(0) = UnfoldMe(tri(0),0,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),"A")
		cut(1) = UnfoldMe(tri(1),cut(0)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),"B")
		cut(2) = UnfoldMe(tri(2),cut(1)+5,CDbl(arrResults(4)),oculi,CDbl(arrResults(3)),"C")
	End If

	Call Rhino.EnableRedraw(True)

End Sub
Function TriangulateSurface(surface,cols,rows,offset,arrOffset)
	TriangulateSurface = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	uDom = Rhino.SurfaceDomain(surface,0)(1): uStep = uDom/cols
	vDom = Rhino.SurfaceDomain(surface,1)(1): VStep = vDom/rows

	ReDim uv(rows),pt(rows),ptA(rows),ptB(rows),uvSet(cols),ptSet(cols),ptSetA(cols),ptSetB(cols)
	'plot point grid
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			uv(j) = array(i*uStep,j*vStep)
			ptB(j) = Rhino.EvaluateSurface(surface,uv(j))
			If arrOffset(i)(j) < .1 Then
				arrOffset(i)(j) = .1
			End If

			If i Mod(2) Then
				If j Mod(2) Then
					pt(j) = Rhino.EvaluateSurface(surface,uv(j))
					ptA(j)= pt(j)
				Else
					pt(j) = Rhino.EvaluateSurface(surface,uv(j))
					ptA(j)= pt(j)
					pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),offset*arrOffset(i)(j)))
					ptA(j)= Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),-offset*arrOffset(i)(j)))
				End If
			Else
				If j Mod(2) Then
					pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),offset*arrOffset(i)(j)))
					ptA(j)= Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),-offset*arrOffset(i)(j)))
				Else
					pt(j) = Rhino.EvaluateSurface(surface,uv(j))
					ptA(j)= pt(j)
				End If
			End If
	Next
	uvSet(i) = uv
	ptSet(i) = pt
	ptSetA(i)= ptA
	ptSetB(i)= ptB

	Next
	TriangulateSurface = array(ptSet,ptSetA,ptSetB)
End Function
Function SurfaceMe(ptSet,scale,minVal,objLayer)
	SurfaceMe = Null
	If Rhino.IsLayer(objLayer) = False Then
		Call Rhino.AddLayer(objLayer,RGB(0,0,255))
	End If

	Dim i,j
	Dim cols, rows
	Dim pts(1)
	cols = uBound(ptSet)
	rows = uBound(ptSet(0))

	Dim srfA(),srfB(),cPt(1)
	ReDim srfA(rows-1),srfB(rows-1)
	ReDim s(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			If scale(i)(j) > 0.9 Then
				If i Mod(2) Then
					If j Mod(2) Then
						srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
						srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
					Else
						srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
						srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
					End If
				Else
					If j Mod(2) Then
						srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
						srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
					Else
						srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
						srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
					End If
				End If
				Call Rhino.ObjectLayer(srfA(j),objLayer)
				Call Rhino.ObjectLayer(srfB(j),objLayer)
			Else
				If scale(i)(j) < minVal Then
					scale(i)(j) = minVal
				End If
				If i Mod(2) Then
					If j Mod(2) Then
						pts(0) = array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j))
						pts(1) = array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j))
						cPt(0) = incenter(pts(0)(0),pts(0)(1),pts(0)(2))
						cPt(1) = incenter(pts(1)(0),pts(1)(1),pts(1)(2))
						srfA(j)= innerSurf(cPt(0),pts(0),scale(i)(j))
						srfB(j)= innerSurf(cPt(1),pts(1),scale(i)(j))
					Else
						pts(0) = array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j))
						pts(1) = array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j))
						cPt(0) = incenter(pts(0)(0),pts(0)(1),pts(0)(2))
						cPt(1) = incenter(pts(1)(0),pts(1)(1),pts(1)(2))
						srfA(j)= innerSurf(cPt(0),pts(0),scale(i)(j))
						srfB(j)= innerSurf(cPt(1),pts(1),scale(i)(j))
					End If
				Else
					If j Mod(2) Then
						pts(0) = array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j))
						pts(1) = array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j))
						cPt(0) = incenter(pts(0)(0),pts(0)(1),pts(0)(2))
						cPt(1) = incenter(pts(1)(0),pts(1)(1),pts(1)(2))
						srfA(j)= innerSurf(cPt(0),pts(0),scale(i)(j))
						srfB(j)= innerSurf(cPt(1),pts(1),scale(i)(j))
					Else
						pts(0) = array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j))
						pts(1) = array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j))
						cPt(0) = incenter(pts(0)(0),pts(0)(1),pts(0)(2))
						cPt(1) = incenter(pts(1)(0),pts(1)(1),pts(1)(2))
						srfA(j)= innerSurf(cPt(0),pts(0),scale(i)(j))
						srfB(j)= innerSurf(cPt(1),pts(1),scale(i)(j))
					End If
				End If
				Call Rhino.ObjectLayer(srfA(j)(1),objLayer)
				Call Rhino.ObjectLayer(srfB(j)(1),objLayer)
			End If
		Next
		s(i) = array(srfA,srfB)
	Next
	SurfaceMe = s
End Function
Function UnfoldMe(ptSet,y,tabHeight,scale,minVal,prefix)
	UnfoldMe= Null
	If Rhino.IsLayer("cuts") = False Then
		Call Rhino.AddLayer("cuts",RGB(255,0,0))
	End If
	If Rhino.IsLayer("scores") = False Then
		Call Rhino.AddLayer("scores",RGB(0,0,0))
	End If

	Dim i,j,r
	Dim cols, rows, wrldCS
	cols = uBound(ptSet)
	rows = uBound(ptSet(0))
	wrldCS = Rhino.WorldXYPlane()
	Dim oriPt(), angX(), ptA(), ptB(), ptC(),pts(),minX(),maxX(),mn(),mx()
	ReDim oriPt(rows-1), angX(rows-1), ptA(rows-1), ptB(rows-1), ptC(rows-1),minX(rows-1),maxX(rows-1),mn(cols-1),mx(cols-1),pts(cols-1)

	Dim angA(),angB(),angC(),disA(),disB(),disC(),s(),a(),d()
	ReDim angA(rows-1),angB(rows-1),angC(rows-1),disA(rows-1),disB(rows-1),disC(rows-1)
	ReDim a(cols-1), d(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				If j Mod(2) Then
					angA(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j+1)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i)(j),ptSet(i+1)(j))
					disB(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
					disC(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
				Else
					angA(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i+1)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j+1)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i)(j))
					disB(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
					disC(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
				End If
			Else
				If j Mod(2) Then
					angA(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i+1)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j+1)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i)(j))
					disB(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
					disC(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
				Else
					angA(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j+1)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i)(j),ptSet(i+1)(j))
					disB(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
					disC(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
				End If
			End If
		Next
		a(i) = array(angA,angB,angC)
		d(i) = array(disA,disB,disC)
	Next

	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If j = 0 Then
				oriPt(j) = array(0,y,0)
				angX(j) = 0
			Else
				oriPt(j) = ptB(j-1)
				If ptB(j-1)(1) > ptC(j-1)(1) Then
					angX(j) = -Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
				Else
					angX(j) = Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
				End If
			End If
			If i Mod(2) Then
				r = j+1
			Else
				r = j
			End If
			If r Mod(2) Then
				ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
				ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(1)(j)+a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
				ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
			Else
				ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
				ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
				ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(1)(j)-a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
			End If
			minX(j) = Rhino.Min(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
			maxX(j) = Rhino.Max(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
			r=r+1
		Next
		mn(i) = Rhino.Min(minX)
		If mn(i) > 0 Then
			mn(i) = 0
		Else
			mn(i) = abs(mn(i))
		End If
		mx(i) = abs(Rhino.Max(maxX))
		pts(i) = array(oriPt,ptA,ptB,ptC)
	Next
	Dim ptX, k,u
	Dim points(3),yVal(3),dblY
	ReDim yMax(rows-1), yM(cols-1)
	Dim edge(),edgeA(), edgeB(), span()
	ReDim edge(cols-1),edgeA(rows-1), edgeB(rows-1), span(rows*2)
	Dim cPt(1), oculi(1)
	r=0
	For i = 0 To cols-1 Step 1
		k=0
		If i > 0 Then
			r = r+mx(i-1)+mn(i)+tabHeight*2
		End If
		For j = 0 To rows-1 Step 1
			ptX	= array(r,0,0)
			For u = 0 To 3 Step 1
				points(u) = Rhino.PointAdd(ptX,pts(i)(u)(j))
			Next
			If j Mod(2) Then
				span(k) = Rhino.AddLine(points(0),points(3))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			Else
				span(k) = Rhino.AddLine(points(1),points(2))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			End If
			If j = 0 Then
				span(k) = Rhino.AddLine(points(0),points(1))
				Call Rhino.ObjectLayer(span(k),"cuts")
				k=k+1
			End If
			If j = rows-1 Then
				span(k) = Rhino.AddLine(points(2),points(3))
				Call Rhino.ObjectLayer(span(k),"cuts")
				k=k+1
			Else
				span(k) = Rhino.AddLine(points(2),points(3))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			End If

			If scale(i)(j) <= .9 Then
				If scale(i)(j) < minVal Then
					scale(i)(j) = minVal
				End If
				If j Mod(2) Then
					cPt(0) = incenter(points(0),points(2),points(3))
					cPt(1) = incenter(points(0),points(1),points(3))
					oculi(0) = innerEdge(cPt(0),array(points(0),points(2),points(3)),scale(i)(j))
					oculi(1) = innerEdge(cPt(1),array(points(0),points(1),points(3)),scale(i)(j))
				Else
					cPt(0) = incenter(points(0),points(1),points(2))
					cPt(1) = incenter(points(2),points(1),points(3))
					oculi(0) = innerEdge(cPt(0),array(points(0),points(1),points(2)),scale(i)(j))
					oculi(1) = innerEdge(cPt(1),array(points(2),points(1),points(3)),scale(i)(j))
				End If

				Call Rhino.ObjectLayer(oculi(0)(1),"cuts")
				Call Rhino.ObjectLayer(oculi(1)(1),"cuts")
			End If

			edgeA(j) = Rhino.AddLine(points(0),points(2))
			Call Rhino.ObjectLayer(edgeA(j),"scores")
			edgeB(j) = Rhino.AddLine(points(1),points(3))
			Call Rhino.ObjectLayer(edgeB(j),"scores")
			For u = 0 To 3 Step 1
				yVal(u) = points(u)(1)
			Next
			yMax(j) = Rhino.Max(yVal)
		Next
		edge(i) = array(edgeA,edgeB)
		yM(i) = Rhino.Max(yMax)
	Next
	dblY = Rhino.Max(yM)
	Dim tabA(), tabB(), lblA(), lblB()
	ReDim tabA(rows-1), tabB(rows-1), lblA(rows-1), lblB(rows-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			tabA(j) = tabMaker(edge(i)(0)(j),-90,tabHeight)
			tabB(j) = tabMaker(edge(i)(1)(j),90,tabHeight)
			Call Rhino.ObjectLayer(tabA(j),"cuts")
			Call Rhino.ObjectLayer(tabB(j),"cuts")

			If i = cols-1 Then
				lblB(j) = labelMaker(edge(i)(1)(j),CStr(prefix) & "." & cols-1 & "." & j,tabHeight*.3,0,True)
			Else
				lblB(j) = labelMaker(edge(i)(1)(j),CStr(prefix) & "." & i+1 & "." & j,tabHeight*.3,0,True)
			End If
			lblA(j) = labelMaker(edge(i)(0)(j),CStr(prefix) & "." & i & "." & j,tabHeight*.3,180,True)
	Next
	Next
	UnfoldMe = dblY
End Function
Function tabMaker(curve,rotVal,scale)
	tabMaker = Null
	Dim tabLN(1), tabPT(2),crvDom, wrldCS, i
	crvDom = Rhino.CurveDomain(curve)
	wrldCS = Rhino.WorldXYPlane()
	tabPT(0) = Rhino.CurveStartPoint(curve)
	tabPT(2) = Rhino.CurveEndPoint(curve)
	tabPT(1) = 	Rhino.PointAdd(Rhino.EvaluateCurve(curve,crvDom(1)*.5),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorRotate(Rhino.VectorCreate(Rhino.EvaluateCurve(curve,crvDom(1)*.4),tabPT(2)),rotVal,wrldCS(3))),scale))
	For i = 0 To 1 Step 1
		tabLN(i) = Rhino.AddLine(tabPT(i),tabPT(i+1))
	Next
	tabMaker = tabLN
End Function
Function labelMaker(curve,title,size,angle,blnAlign)
	labelMaker = Null
	Dim txt, wrldCS
	If Rhino.IsLayer("numbering") = False Then
		Call Rhino.AddLayer("numbering",RGB(0,255,0))
	End If
	wrldCS = Rhino.WorldXYPlane()
	txt = Rhino.AddText(title,Rhino.CurveMidPoint(curve),size)
	If blnAlign = True Then
		Call Rhino.TextObjectPlane(txt,array(Rhino.CurveMidPoint(curve),Rhino.VectorCreate(Rhino.CurveMidPoint(curve),Rhino.CurveEndPoint(curve)),Rhino.VectorRotate(Rhino.VectorCreate(Rhino.CurveMidPoint(curve),Rhino.CurveEndPoint(curve)),90,wrldCS(3)),wrldCS(3)))
		Call Rhino.RotateObject(txt,Rhino.CurveMidPoint(curve),angle,wrldCS(3))
	End If
	Call Rhino.ObjectLayer(txt,"numbering")
	labelMaker = txt
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1")
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1")
		Call rhino.UnselectAllObjects()
	End If
End Function
Function incenter(ptA,ptB,ptC)
	incenter = Null
	Dim A,B,C
	Dim x,y,z

	A = Rhino.Distance(PtB,ptC)
	B = Rhino.Distance(PtA,ptC)
	C = Rhino.Distance(ptA,ptB)

	x = (ptA(0)*A + ptB(0)*B + ptC(0)*C) / (A + B + C)
	y = (ptA(1)*A + ptB(1)*B + ptC(1)*C) / (A + B + C)
	z = (ptA(2)*A + ptB(2)*B + ptC(2)*C) / (A + B + C)
	incenter = array(x,y,z)
End Function
Function innerEdge(cent,arrPoints,scale)
	innerEdge = Null
	Dim i, count
	count = uBound(arrPoints)
	Dim dist,pt(), edge()
	ReDim pt(count), edge(count)
	For i = 0 To count Step 1
		dist = Rhino.Distance(cent,arrPoints(i))
		pt(i)= Rhino.PointAdd(arrPoints(i),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(cent,arrPoints(i))),dist*scale))
	Next
	For i = 0 To count Step 1
		If i = 0 Then
			edge(i) = Rhino.AddLine(pt(count),pt(0))
		Else
			edge(i) = Rhino.AddLine(pt(i),pt(i-1))
		End If
	Next

	innerEdge = array(pt, edge)
End Function
Function innerSurf(cent,arrPoints,scale)
	innerSurf = Null
	Dim i, count
	count = uBound(arrPoints)
	Dim dist,pt(), srf()
	ReDim pt(count), srf(count)
	For i = 0 To count Step 1
		dist = Rhino.Distance(cent,arrPoints(i))
		pt(i)= Rhino.PointAdd(arrPoints(i),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(cent,arrPoints(i))),dist*scale))
	Next
	For i = 0 To count Step 1
		If i = 0 Then
			srf(i) = Rhino.AddSrfPt(array(pt(count),pt(0),arrPoints(0),arrPoints(count)))
		Else
			srf(i) = Rhino.AddSrfPt(array(pt(i),pt(i-1),arrPoints(i-1),arrPoints(i)))
		End If
	Next

	innerSurf = array(pt, srf)
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function

	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If

	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If

	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)

	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j

			If x>w Then
				x = w
			End If

			If y>h Then
				y = h
			End If

			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)

		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
	arrayValue = Null
	Dim i,j
	ReDim val(rows), arrVal(cols)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			val(j) = value
		Next
		arrVal(i) = val
	Next
	arrayValue = arrVal
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Monday, May 26, 2008 1:43:26 PM

Call Main()
Sub Main()
	Dim surf
	surf = Rhino.GetObject("select surface",8)
	If isNull(surf) Then Exit Sub
	Call reparameterize(surf)

	Dim arrItems, arrValues, arrResults
	arrItems = array("Colums","Rows","Offset","tabHeight","ripple","cutTemplate","surfaces")
	arrValues= array(20,20,2,1,False,True,True)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Volume Parameters")
	Dim tri
	Call Rhino.EnableRedraw(False)
	tri = TriangulateSurface(surf,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)),array(CBool(arrResults(4))))
	If CBool(arrResults(6)) = True Then
		Call SurfaceMe(tri,RGB(255,0,0))
	End If

	If CBool(arrResults(5)) = True Then
		Call UnfoldMe(tri,CDbl(arrResults(3)))
	End If

	Call Rhino.EnableRedraw(True)

End Sub
Function TriangulateSurface(surface,cols,rows,offset,arrBln)
	TriangulateSurface = Null
	Dim i,j
	Dim uDom,vDom,uStep,vStep
	uDom = Rhino.SurfaceDomain(surface,0)(1): uStep = uDom/cols
	vDom = Rhino.SurfaceDomain(surface,1)(1): VStep = vDom/rows

	ReDim uv(rows),pt(rows),uvSet(cols),ptSet(cols)
	'plot point grid
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			uv(j) = array(i*uStep,j*vStep)
			If i Mod(2) Then
				If j Mod(2) Then
					pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),offset))

				Else
					pt(j) = Rhino.EvaluateSurface(surface,uv(j))
				End If
			Else
				If j Mod(2) Then
					pt(j) = Rhino.EvaluateSurface(surface,uv(j))
				Else
					If arrBln(0) = True Then
						pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),-offset))
					Else
						pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,uv(j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,uv(j))),offset))
					End If
				End If
			End If
		Next
		uvSet(i) = uv
		ptSet(i) = pt
	Next
	TriangulateSurface = ptSet
End Function
Function SurfaceMe(ptSet,objClr)
	SurfaceMe = Null
	If Rhino.IsLayer("surfaces") = False Then
		Call Rhino.AddLayer("surfaces",RGB(0,0,255))
	End If

	Dim i,j
	Dim cols, rows
	cols = uBound(ptSet)
	rows = uBound(ptSet(0))

	Dim srfA(),srfB()
	ReDim srfA(rows-1),srfB(rows-1)
	ReDim s(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				If j Mod(2) Then
					srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
					srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
				Else
					srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
					srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
				End If
			Else
				If j Mod(2) Then
					srfA(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j),ptSet(i+1)(j+1),ptSet(i)(j)))
					srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j+1),ptSet(i+1)(j+1),ptSet(i)(j)))
				Else
					srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j),ptSet(i)(j+1),ptSet(i+1)(j)))
					srfB(j) = Rhino.AddSrfPt(array(ptSet(i+1)(j+1),ptSet(i)(j+1),ptSet(i+1)(j)))
				End If
			End If
			Call Rhino.ObjectColor(srfA(j),objClr)
			Call Rhino.ObjectColor(srfB(j),objClr)
			Call Rhino.ObjectLayer(srfA(j),"surfaces")
			Call Rhino.ObjectLayer(srfB(j),"surfaces")
		Next
		s(i) = array(srfA,srfB)
	Next
	SurfaceMe = s
End Function
Function UnfoldMe(ptSet,tabHeight)
	UnfoldMe= Null
	If Rhino.IsLayer("cuts") = False Then
		Call Rhino.AddLayer("cuts",RGB(255,0,0))
	End If
	If Rhino.IsLayer("scores") = False Then
		Call Rhino.AddLayer("scores",RGB(0,0,0))
	End If

	Dim i,j,r
	Dim cols, rows, wrldCS
	cols = uBound(ptSet)
	rows = uBound(ptSet(0))
	wrldCS = Rhino.WorldXYPlane()
	Dim oriPt(), angX(), ptA(), ptB(), ptC(),pts(),minX(),maxX(),mn(),mx()
	ReDim oriPt(rows-1), angX(rows-1), ptA(rows-1), ptB(rows-1), ptC(rows-1),minX(rows-1),maxX(rows-1),mn(cols-1),mx(cols-1),pts(cols-1)

	Dim angA(),angB(),angC(),disA(),disB(),disC(),s(),a(),d()
	ReDim angA(rows-1),angB(rows-1),angC(rows-1),disA(rows-1),disB(rows-1),disC(rows-1)
	ReDim a(cols-1), d(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				If j Mod(2) Then
					angA(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j+1)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i)(j),ptSet(i+1)(j))
					disB(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
					disC(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
				Else
					angA(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i+1)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j+1)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i)(j))
					disB(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
					disC(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
				End If
			Else
				If j Mod(2) Then
					angA(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i+1)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j+1)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i)(j))
					disB(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
					disC(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
				Else
					angA(j) = Rhino.angle2(array(ptSet(i)(j),ptSet(i+1)(j)),array(ptSet(i)(j),ptSet(i)(j+1)))(0)
					angB(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j)),array(ptSet(i+1)(j),ptSet(i)(j+1)))(0)
					angC(j) = Rhino.angle2(array(ptSet(i+1)(j),ptSet(i)(j+1)),array(ptSet(i+1)(j),ptSet(i+1)(j+1)))(0)
					disA(j) = Rhino.Distance(ptSet(i)(j),ptSet(i+1)(j))
					disB(j) = Rhino.Distance(ptSet(i)(j),ptSet(i)(j+1))
					disC(j) = Rhino.Distance(ptSet(i+1)(j),ptSet(i+1)(j+1))
				End If
			End If
		Next
		a(i) = array(angA,angB,angC)
		d(i) = array(disA,disB,disC)
	Next

	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If j = 0 Then
				oriPt(j) = array(0,0,0)
				angX(j) = 0
			Else
				oriPt(j) = ptB(j-1)
				If ptB(j-1)(1) > ptC(j-1)(1) Then
					angX(j) = -Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
				Else
					angX(j) = Rhino.Angle2(array(ptB(j-1),Rhino.PointAdd(ptB(j-1),wrldCS(1))),array(ptB(j-1),ptC(j-1)))(0)
				End If
			End If
			If i Mod(2) Then
				r = j+1
			Else
				r = j
			End If
			If r Mod(2) Then
				ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
				ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(1)(j)+a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
				ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
			Else
				ptA(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j),wrldCS(3)),d(i)(0)(j)))
				ptB(j) = Rhino.PointAdd(oriPt(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+a(i)(0)(j),wrldCS(3)),d(i)(1)(j)))
				ptC(j) = Rhino.PointAdd(ptA(j),Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1),angX(j)+180-a(i)(1)(j)-a(i)(2)(j),wrldCS(3)),d(i)(2)(j)))
			End If
			minX(j) = Rhino.Min(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
			maxX(j) = Rhino.Max(array(ptA(j)(0),ptB(j)(0),ptC(j)(0)))
			r=r+1
		Next
		mn(i) = Rhino.Min(minX)
		If mn(i) > 0 Then
			mn(i) = 0
		Else
			mn(i) = abs(mn(i))
		End If
		mx(i) = abs(Rhino.Max(maxX))
		pts(i) = array(oriPt,ptA,ptB,ptC)
	Next
	Dim ptX, k
	Dim edge(),edgeA(), edgeB(), span()
	ReDim edge(cols-1),edgeA(rows-1), edgeB(rows-1), span(rows*2)
	r=0
	For i = 0 To cols-1 Step 1
		k=0
		If i > 0 Then
			r = r+mx(i-1)+mn(i)+tabHeight*2
		End If
		For j = 0 To rows-1 Step 1
			ptX	= array(r,0,0)
			If j Mod(2) Then
				span(k) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(0)(j)),Rhino.PointAdd(ptX,pts(i)(3)(j)))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			Else
				span(k) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(1)(j)),Rhino.PointAdd(ptX,pts(i)(2)(j)))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			End If
			If j = 0 Then
				span(k) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(0)(j)),Rhino.PointAdd(ptX,pts(i)(1)(j)))
				Call Rhino.ObjectLayer(span(k),"cuts")
				k=k+1
			End If
			If j = rows-1 Then
				span(k) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(2)(j)),Rhino.PointAdd(ptX,pts(i)(3)(j)))
				Call Rhino.ObjectLayer(span(k),"cuts")
				k=k+1
			Else
				span(k) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(2)(j)),Rhino.PointAdd(ptX,pts(i)(3)(j)))
				Call Rhino.ObjectLayer(span(k),"scores")
				k=k+1
			End If
			edgeA(j) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(0)(j)),Rhino.PointAdd(ptX,pts(i)(2)(j)))
			Call Rhino.ObjectLayer(edgeA(j),"scores")
			edgeB(j) = Rhino.AddLine(Rhino.PointAdd(ptX,pts(i)(1)(j)),Rhino.PointAdd(ptX,pts(i)(3)(j)))
			Call Rhino.ObjectLayer(edgeB(j),"scores")
		Next
		edge(i) = array(edgeA,edgeB)
	Next

	Dim tabA(), tabB(), lblA(), lblB()
	ReDim tabA(rows-1), tabB(rows-1), lblA(rows-1), lblB(rows-1)
	For i = 0 To cols-1 Step 1
		For j = 0 To rows-1 Step 1
			tabA(j) = tabMaker(edge(i)(0)(j),-90,tabHeight)
			tabB(j) = tabMaker(edge(i)(1)(j),90,tabHeight)
			Call Rhino.ObjectLayer(tabA(j),"cuts")
			Call Rhino.ObjectLayer(tabB(j),"cuts")

			If i = cols-1 Then
				lblB(j) = labelMaker(edge(i)(1)(j),cols-1 & "." & j,tabHeight*.25,0,True)
			Else
				lblB(j) = labelMaker(edge(i)(1)(j),i+1 & "." & j,tabHeight*.25,0,True)
			End If
			lblA(j) = labelMaker(edge(i)(0)(j),i & "." & j,tabHeight*.25,180,True)
	Next
	Next
End Function
Function tabMaker(curve,rotVal,scale)
	tabMaker = Null
	Dim tabLN(1), tabPT(2),crvDom, wrldCS, i
	crvDom = Rhino.CurveDomain(curve)
	wrldCS = Rhino.WorldXYPlane()
	tabPT(0) = Rhino.CurveStartPoint(curve)
	tabPT(2) = Rhino.CurveEndPoint(curve)
	tabPT(1) = 	Rhino.PointAdd(Rhino.EvaluateCurve(curve,crvDom(1)*.5),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorRotate(Rhino.VectorCreate(Rhino.EvaluateCurve(curve,crvDom(1)*.4),tabPT(2)),rotVal,wrldCS(3))),scale))
	For i = 0 To 1 Step 1
		tabLN(i) = Rhino.AddLine(tabPT(i),tabPT(i+1))
	Next
	tabMaker = tabLN
End Function
Function labelMaker(curve,title,size,angle,blnAlign)
	labelMaker = Null
	Dim txt, wrldCS
	If Rhino.IsLayer("numbering") = False Then
		Call Rhino.AddLayer("numbering",RGB(0,255,0))
	End If
	wrldCS = Rhino.WorldXYPlane()
	txt = Rhino.AddText(title,Rhino.CurveMidPoint(curve),size)
	If blnAlign = True Then
		Call Rhino.TextObjectPlane(txt,array(Rhino.CurveMidPoint(curve),Rhino.VectorCreate(Rhino.CurveMidPoint(curve),Rhino.CurveEndPoint(curve)),Rhino.VectorRotate(Rhino.VectorCreate(Rhino.CurveMidPoint(curve),Rhino.CurveEndPoint(curve)),90,wrldCS(3)),wrldCS(3)))
		Call Rhino.RotateObject(txt,Rhino.CurveMidPoint(curve),angle,wrldCS(3))
	End If
	Call Rhino.ObjectLayer(txt,"numbering")
	labelMaker = txt
End Function
Function reparameterize(strObjectID)
	If Rhino.IsCurve(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1")
		Call rhino.UnselectAllObjects()
	End If
	If Rhino.IsSurface(strObjectID) = True Then
		Call rhino.SelectObject(strObjectID)
		Call rhino.Command("reparameterize 0 1 0 1")
		Call rhino.UnselectAllObjects()
	End If
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Saturday, March 07, 2009 6:11:13 PM

Call Main()
Sub Main()
	Dim surface, arrValue
	Dim cols, rows, dept, spac
	surface = Rhino.GetObject("Select Surface",8,True)
	If isnull(surface) Then Exit Sub

	arrValue = Rhino.PropertyListBox(array("Columns","Rows","TabHeight","Spacing"),array(10,10,2,2),"Surface Parameters","Input Parameters")
	If isNull(arrValue) Then Exit Sub

	cols = CDbl(arrValue(0))
	rows = CDbl(arrValue(1))
	dept = CDbl(arrValue(2))
	spac = CDbl(arrValue(3))

	Call reparameterize(surface)
	Call Rhino.EnableRedraw(False)

	Dim triangles, cuts, tile, tabs, tri, strip
	triangles = triangulate(surface,cols,rows)
	cuts = reOrient(triangles)
	tri = drawTriangle(triangles)
	strip = makeStrips(cuts)
	tile = tileObject(strip, spac+dept)

	Dim i,j,k,r,s,t
	For i = 0 To ubound(triangles) Step 1
		r = 0
		s = 0
		For j = 0 To ubound(triangles(i)) Step 1
			If j Mod(2) Then
				s = s+1
				t = i+1
				If j > 0 Then
					Call Rhino.DeleteObject(cuts(i)(j)(0))
				End If
				If j<ubound(triangles(i)) Then
					Call Rhino.ObjectColor(cuts(i)(j)(1),RGB(255,0,0))
				End If
			Else
				r = r+1
				t = i
				If j > 0 Then
					Call Rhino.DeleteObject(cuts(i)(j)(1))
				End If
				Call Rhino.ObjectColor(cuts(i)(j)(0),RGB(255,0,0))
			End If

			tabs = tabmaker(cuts(i)(j)(2),dept,CStr("2." & i & "." & r))
			Call labelEdge(tri(i)(j)(2),CStr("2." & t & "." & r))
			Call Rhino.ObjectColor(cuts(i)(j)(2),RGB(255,0,0))
			Call Rhino.AddSrfPt(triangles(i)(j))
		Next
	Next

	Call Rhino.EnableRedraw(True)

End Sub
Function drawTriangle(arrPoints)
	drawTriangle = Null
	Dim i,j,k
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next

	drawTriangle = arrOutput
End Function
Function reOrient(arrPoints)
	reOrient = Null
	Dim i,j,k
	Dim cPlane, wplane
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
				Call Rhino.OrientObject(crv(k),array(arrPoints(i)(j)(0),arrPoints(i)(j)(1),arrPoints(i)(j)(2)),array(array(0,0,0),array(1,0,0),array(0,1,0)))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next

	reOrient = arrOutput
End Function
Function makeStrips(arrObjects)
	makeStrips = Null
	Dim arrOutput(), arrVal()
	ReDim arrOutput(ubound(arrObjects))
	Dim i,j,k,r
	Dim ptA(2), ptB(2)
	For i = 0 To ubound(arrObjects) Step 1
		r=0
		ReDim arrVal(r)
		For j = 0 To ubound(arrObjects(i))-1 Step 1
			If j Mod(2) Then
				ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j+1)(1))
				ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j+1)(1))
				ptA(2) = array(ptA(0)(0),ptA(0)(1),ptA(0)(2)+1)

				ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(1))
				ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(1))
				ptB(2) = array(ptB(0)(0),ptB(0)(1),ptB(0)(2)+1)
			Else
				ptA(0) = Rhino.CurveStartPoint(arrObjects(i)(j+1)(0))
				ptA(1) = Rhino.CurveEndPoint(arrObjects(i)(j+1)(0))
				ptA(2) = array(ptA(0)(0),ptA(0)(1),ptA(0)(2)+1)

				ptB(0) = Rhino.CurveEndPoint(arrObjects(i)(j)(0))
				ptB(1) = Rhino.CurveStartPoint(arrObjects(i)(j)(0))
				ptB(2) = array(ptB(0)(0),ptB(0)(1),ptB(0)(2)+1)
			End If

			Call Rhino.OrientObjects(arrObjects(i)(j+1),ptA,ptB)
			If j = 0 Then
				For k = 0 To ubound(arrObjects(i)(j)) Step 1
					ReDim Preserve arrVal(r)
					arrVal(r) = arrObjects(i)(j)(k)
					r = r+1
				Next
			End If
			For k = 0 To ubound(arrObjects(i)(j+1)) Step 1
				ReDim Preserve arrVal(r)
				arrVal(r) = arrObjects(i)(j+1)(k)
				r = r+1
			Next
		Next
		arrOutput(i) = arrVal
	Next
	makeStrips = arrOutput
End Function
Function tabMaker(curve,depth,text)
	tabMaker = Null
	Dim arrOutput, pt(3), txt
	pt(0) = Rhino.CurveMidPoint(curve)
	pt(1) = Rhino.CurveStartPoint(curve)
	pt(2) = Rhino.CurveEndPoint(curve)
	pt(3) = Rhino.PointAdd(pt(0),Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(pt(1),pt(2))),depth),90,Rhino.WorldXYPlane()(3)))
	arrOutput = Rhino.AddPolyline(array(pt(1),pt(3),pt(2)))
	txt = Rhino.AddText(text,pt(0),depth*0.3)
	Call Rhino.ObjectColor(txt,RGB(0,255,0))
	Call Rhino.OrientObject(txt,array(pt(0),array(pt(0)(0)+1,pt(0)(1),pt(0)(2)),array(pt(0)(0),pt(0)(1)+1,pt(0)(2))),array(pt(0),pt(1),pt(3)))
	tabMaker = arrOutput
End Function
Function labelEdge(curve,text)
	labelEdge = Null
	Dim arrOutput, pt
	pt = Rhino.CurveMidPoint(curve)
	arrOutput = Rhino.AddTextDot(text,pt)
	labelEdge = arrOutput
End Function
Function tileObject(arrObjects, spacing)
	tileObject = Null
	Dim arrOutput(), arrVal()
	ReDim arrOutput(ubound(arrObjects)), arrVal(ubound(arrObjects(0)))
	Dim i,s
	Dim bBox, pt()
	ReDim pt(ubound(arrObjects))
	s=0
	For i = 0 To uBound(arrObjects) Step 1
		bBox = Rhino.BoundingBox(arrObjects(i))
		If i > 0 Then
			arrOutput(i) = Rhino.MoveObjects(arrObjects(i),bBox(0),pt(i-1))
		Else
			arrOutput(i) = Rhino.MoveObjects(arrObjects(i),bBox(0),bBox(0))
		End If
		bBox = Rhino.BoundingBox(arrObjects(i))
		pt(i) = array(bBox(1)(0)+spacing,bBox(1)(1),bBox(1)(2))
	Next

	tileObject = arrOutput
End Function
Function triangulate(surface,cols,rows)
	triangulate = Null
	Dim arrOutput(), arrVal(), tVal(3), iStep, jStep
	ReDim arrOutput(rows-1), arrVal(cols*2-1)
	Dim i,j,r

	iStep = Rhino.SurfaceDomain(surface,0)(1)/rows
	jStep = Rhino.SurfaceDomain(surface,1)(1)/cols

	For i = 0 To rows-1 Step 1
		r=0
		For j = 0 To cols-1 Step 1
			tval(0) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*(j+1)))
			tval(1) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*j))
			tval(2) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*j))
			tval(3) = tval(0)

			arrVal(r) = tval

			tval(0) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*j))
			tval(1) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*(j+1)))
			tval(2) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*(j+1)))
			tval(3) = tval(0)
			arrVal(r+1) = tval

			r=r+2
		Next
		arrOutput(i) = arrVal
	Next

	triangulate = arrOutput
End Function
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

This simple triangulation fabrication script evaluates a surface and creates a tiled set of triangulated pieces with incrementally numbered tabs. To assemble, simply combine tabs with matching numbers… and your done.

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Studio>
'Script version Saturday, March 07, 2009 6:11:13 PM

Call Main()
Sub Main()
	Dim surface, arrValue
	Dim cols, rows, dept, spac
	surface = Rhino.GetObject("Select Surface",8,True)
	If isnull(surface) Then Exit Sub

	arrValue = Rhino.PropertyListBox(array("Columns","Rows","TabHeight","Spacing"),array(10,10,2,2),"Surface Parameters","Input Parameters")
	If isNull(arrValue) Then Exit Sub

	cols = CDbl(arrValue(0))
	rows = CDbl(arrValue(1))
	dept = CDbl(arrValue(2))
	spac = CDbl(arrValue(3))

	Call reparameterize(surface)
	Call Rhino.EnableRedraw(False)

	Dim triangles, cuts, tile, tabs,tri
	triangles = triangulate(surface,cols,rows)
	cuts = reOrient(triangles)
	tile = tileObjects(cuts, spac+dept)
	tri = drawTriangle(triangles)

	Dim i,j,k,r,s,t
	For i = 0 To ubound(triangles) Step 1
		r = 0
		s = 0
		For j = 0 To ubound(triangles(i)) Step 1
			If j Mod(2) Then
				s = s+1
				t = i+1
			Else
				r = r+1
				t = i
			End If
			tabs = tabmaker(tile(i)(j)(0),dept,CStr(i & "." & "0." & r))
			Call labelEdge(tri(i)(j)(0),CStr(i & "." & "0." & r))

			tabs = tabmaker(tile(i)(j)(1),dept,CStr(i & "." & "1." &  s))
			Call labelEdge(tri(i)(j)(1),CStr(i & "." & "1." &  s))

			tabs = tabmaker(tile(i)(j)(2),dept,CStr("2." & i & "." & r))
			Call labelEdge(tri(i)(j)(2),CStr("2." & t & "." & r))
			Call Rhino.AddSrfPt(triangles(i)(j))
		Next
	Next
	Call Rhino.EnableRedraw(True)

End Sub
Function drawTriangle(arrPoints)
	drawTriangle = Null
	Dim i,j,k
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next

	drawTriangle = arrOutput
End Function
Function reOrient(arrPoints)
	reOrient = Null
	Dim i,j,k
	Dim cPlane, wplane
	Dim curve(), arrOutput(),crv(2)
	ReDim curve(ubound(arrPoints(0))), arrOutput(ubound(arrPoints))
	For i = 0 To ubound(arrPoints) Step 1
		For j = 0 To ubound(arrPoints(i)) Step 1
			For k = 0 To 2 Step 1
				crv(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
				Call Rhino.ObjectColor(crv(k),RGB(255,0,0))
				Call Rhino.OrientObject(crv(k),array(arrPoints(i)(j)(0),arrPoints(i)(j)(1),arrPoints(i)(j)(2)),array(array(0,0,0),array(1,0,0),array(0,1,0)))
			Next
			curve(j) = crv
		Next
		arrOutput(i) = curve
	Next

	reOrient = arrOutput
End Function
Function tabMaker(curve,depth,text)
	tabMaker = Null
	Dim arrOutput, pt(3), txt
	pt(0) = Rhino.CurveMidPoint(curve)
	pt(1) = Rhino.CurveStartPoint(curve)
	pt(2) = Rhino.CurveEndPoint(curve)
	pt(3) = Rhino.PointAdd(pt(0),Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(pt(1),pt(2))),depth),90,Rhino.WorldXYPlane()(3)))
	arrOutput = Rhino.AddPolyline(array(pt(1),pt(3),pt(2)))
	txt = Rhino.AddText(text,pt(0),depth*0.3)
	Call Rhino.ObjectColor(txt,RGB(0,255,0))
	Call Rhino.OrientObject(txt,array(pt(0),array(pt(0)(0)+1,pt(0)(1),pt(0)(2)),array(pt(0)(0),pt(0)(1)+1,pt(0)(2))),array(pt(0),pt(1),pt(3)))
	tabMaker = arrOutput
End Function
Function labelEdge(curve,text)
	labelEdge = Null
	Dim arrOutput, pt
	pt = Rhino.CurveMidPoint(curve)
	arrOutput = Rhino.AddTextDot(text,pt)
	labelEdge = arrOutput
End Function
Function tileObjects(arrObjects, spacing)
	tileObjects = Null
	Dim arrOutput(), arrVal()
	ReDim arrOutput(ubound(arrObjects)), arrVal(ubound(arrObjects(0)))
	Dim i,j,r,s
	Dim bBox, xDis(), yDis(), maxVal
	ReDim xDis(ubound(arrObjects(0))),yDis(ubound(arrObjects(0)))
	r = 0
	For i = 0 To uBound(arrObjects) Step 1
		r = r+maxVal+spacing
		s = 0
		For j = 0 To uBound(arrObjects(i)) Step 1
			bBox = Rhino.BoundingBox(arrObjects(i)(j))
			xDis(j) = Rhino.Distance(bBox(0),bBox(1))
			yDis(j) = Rhino.Distance(bBox(0),bBox(3))
			If j > 0 Then
				s = s+yDis(j-1)+spacing
			End If
			arrVal(j) = Rhino.MoveObjects(arrObjects(i)(j),array(0,0,0),array(r,s,0))
		Next
		maxVal = Rhino.Max(xDis)
		arrOutput(i) = arrVal
	Next

	tileObjects = arrOutput
End Function
Function triangulate(surface,cols,rows)
	triangulate = Null
	Dim arrOutput(), arrVal(), tVal(3), iStep, jStep
	ReDim arrOutput(rows-1), arrVal(cols*2-1)
	Dim i,j,r

	iStep = Rhino.SurfaceDomain(surface,0)(1)/rows
	jStep = Rhino.SurfaceDomain(surface,1)(1)/cols

	For i = 0 To rows-1 Step 1
		r=0
		For j = 0 To cols-1 Step 1
			tval(0) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*(j+1)))
			tval(1) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*j))
			tval(2) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*j))
			tval(3) = tval(0)

			arrVal(r) = tval

			tval(0) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*j))
			tval(1) = Rhino.EvaluateSurface(surface,array(iStep*i,jStep*(j+1)))
			tval(2) = Rhino.EvaluateSurface(surface,array(iStep*(i+1),jStep*(j+1)))
			tval(3) = tval(0)
			arrVal(r+1) = tval

			r=r+2
		Next
		arrOutput(i) = arrVal
	Next

	triangulate = arrOutput
End Function
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

TETRAliefs is individually customizable bi level table surface. With the New York apartment in mind it is designed to be repositioned as a lightweight wall-scape when not in functional use. With any readily available image production software the user can create the simple gray scale pattern which programs the table to meet their particular wants. The result of this image is a three dimensional reference model of the final piece, as well at layer by layer assembly map of the modules construction and a cutting template for fabrication. The cut template and components are designed to reduce fabrication waste through maximization of used material surface area.

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic.net>
'Script version Thursday, May 15, 2008 9:24:31 AM

Call Main()
Sub Main()
	Dim arrClr
	
	Dim arrItems, arrValues, arrResults,blnResult
	arrItems = array("Columns","Rows","Size","Width","Height")
	arrValues= array(10,10,2,32,18)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
	If isNull(arrResults(0)) Then Exit Sub
	arrClr = arrImageSample(arrResults(0)*4, arrResults(1)*2)
	If isNull(arrClr) Then Exit Sub
	
	Call Rhino.EnableRedraw(False)
	Call TetraGrid(CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(2)),arrClr(6))
	Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue)
	cols=cols*4
	TetraGrid = Null
	Dim i,j,k,r,s,t
	Dim x,y,z,c, za
	Dim pt, ptA, clrtype
	'calculate tetrahedron construction ratio's
	x = size
	y = size*cos(PI/6)
	c= size*.5/sin(PI/3)
	z = sqr(x^2-c^2)
	'create packed tetrahedron points
	ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)				
			Else
				ptA = array(x*.5*i,(y+c*1.5)*j,0)
			End If
			'type A
			If arrValue(i)(r)< .4 Then
				za = -z
			Else
				za = z
			End If
			pt = array(ptA(0),ptA(1)-c*2,ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)+za)
			ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
			
			'type B
			If arrValue(i)(r)< .4 Then
				za = -z
			Else
				za = -z
			End If
			pt = array(ptA(0),ptA(1),ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)+za)
			ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
	Next
	ptSet(i) = ptTetra
	Next
	Dim shnVal,lyrName,lyrClr,mtrl(2)
	'create color layers and material colors
	shnVal = 1
	lyrName = array("black","grey","white")
	lyrClr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
	For i = 0 To 2 Step 1
		If Rhino.IsLayer(lyrName(i)) = False Then
			Call Rhino.AddLayer(lyrName(i),lyrClr(i))
			mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
			Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		Else 
			mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		End If
	Next
	
	'create and color surfaces tetrahedron points
	Dim clr, count, upDn
	Dim dwgA(),dwgB(),dwgC()
	ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
	ReDim srfBln(rows*2-2),blnSet(cols-1)
	ReDim srfBlnA(rows*2-2),blnSetA(cols-1)
	r=0:s=0:t=0
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			'adjust for surface normal
			If arrValue(i)(j)< .4 Then
				clr = RGB(1,1,1)
				clrtype = 0
				upDn = 0
			ElseIf arrValue(i)(j) >= .4 And arrValue(i)(j)< .8 Then
				clr = RGB(175,175,175)
				clrtype = 1
				upDn = 1
			Else
				clr = RGB(255,255,255)
				clrtype = 2
				upDn = 1
			End If

			If j Mod(2) Then
				ReDim Preserve dwgA(r)
				srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)))
				dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
				r=r+1
				srfBln(j) = False
			Else
				ReDim Preserve dwgA(r)
				srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(2),ptSet(i)(j)(3)))
				dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
				If arrValue(i)(j) >= .8 Then
					srfBln(j) = True
				Else
					srfBln(j) = False
				End If
				If arrValue(i)(j) < .4 Then
					srfBlnA(j) = True
				Else
					srfBlnA(j) = False
				End If				
			End If
							
			Call Rhino.ObjectColor(srf(0),clr)
			Call Rhino.ObjectLayer(srf(0),lyrName(clrtype))
			
			If j Mod(2) And arrValue(i)(j)> .4 Then
			Else					
				For k = 1 To 3 Step 1			
					If k<3 Then
						srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
						If  upDn= 1 Then
							ReDim Preserve dwgB(s)
							dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgC(t)
							dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
							t=t+1
						End If
					Else
						srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
						If  upDn= 1 Then
							ReDim Preserve dwgB(s)
							dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgC(t)
							dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
							t=t+1
						End If
					End If
					Call Rhino.ObjectColor(srf(k),clr)
					Call Rhino.ObjectLayer(srf(k),lyrName(clrtype))
				Next
			End If
	Next
	blnSet(i) = srfBln
	blnSetA(i)= srfBlnA
	Next
	
	Dim dwgD(),dwgE(),dwgF()
	Dim blnPair, tempSrf, tempPts
	blnPair = array(blnSet,blnSetA)
	r=0:s=0:t=0
	For i = 0 To cols-1 Step 1
		For j = 0 To rows*2-2 Step 1
			'top plates band A
			If ptSet(i)(j)(2)(2) < 0 Or ptSet(i)(j)(3)(2) < 0 Or ptSet(i)(j)(0)(2) < 0 Then
				clr = RGB(1,1,1)
				clrtype=0
				upDN=1
			Else
				clr = RGB(255,255,255)
				clrtype=2
				upDN=0
			End If
			
			If i < cols-2 Then
				If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i+2)(j) = True Then
					tempSrf = Rhino.AddSrfPt(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)))
					ReDim Preserve dwgD(r)
					dwgD(r)= array(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)),clr,clrtype)
					r=r+1
					Call Rhino.ObjectColor(tempSrf,clr)
					Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
				End If
			End If
			
			'top plates band B
			If i > 0 And i < cols-2 And j < rows*2-3 Then
				If i Mod(2) Then
					If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j+2) = True And blnPair(0)(i-1)(j+2) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)))
						ReDim Preserve dwgD(r)
						dwgD(r)= array(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)),clr,clrtype)
						r=r+1
					End If
				Else
					If blnPair(0)(i)(j+2) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i-1)(j) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)))	
						ReDim Preserve dwgD(r)
						dwgD(r)= array(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)),clr,clrtype)
						r=r+1
					End If
				End If
				Call Rhino.ObjectColor(tempSrf,clr)
				Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
			End If
			
			For k = 0 To 1 Step 1
				'front faces all
				If i < cols-2 Then
					If blnPair(k)(i)(j) = True And blnPair(k)(i+2)(j) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)))
						Call Rhino.ObjectColor(tempSrf,clr)
						Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
						If  upDn= 1 Then
							ReDim Preserve dwgE(s)
							dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgF(t)
							dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
							t=t+1
						End If
					End If
				End If
			
				'side faces band A
				If i < cols-2 Then
					If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j) = True Then
						If i Mod(2) Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2)))
							tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2))
						Else
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3)))
							tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3))
						End If
						Call Rhino.ObjectColor(tempSrf,clr)
						Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
						If  upDn= 1 Then
							ReDim Preserve dwgE(s)
							dwgE(s)= array(tempPTs,clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgF(t)
							dwgF(t)= array(tempPTs,clr,clrtype)
							t=t+1
						End If
					End If
				End If
			
				'side faces band B
				If i Mod(2) Then
					If i < cols-2 And j < rows*2-3 Then
						If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j+2) = True Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)))
							Call Rhino.ObjectColor(tempSrf,clr)
							Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
							If  upDn= 1 Then
								ReDim Preserve dwgE(s)
								dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
								s=s+1
							Else
								ReDim Preserve dwgF(t)
								dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
								t=t+1
							End If
						End If
					End If
				Else
					If i < cols-2 And j > 1 Then
						If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j-2) = True Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)))
							Call Rhino.ObjectColor(tempSrf,clr)
							Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
							If  upDn= 1 Then
								ReDim Preserve dwgE(s)
								dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
								s=s+1
							Else
								ReDim Preserve dwgF(t)
								dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
								t=t+1
							End If
						End If
					End If
				End If
			Next
		Next
	Next
	clr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
	Dim pst,pline,off,clrCnt(2)
	clrCnt(0) = 0:clrCnt(1) = 0:clrCnt(2) = 0
	pst = array(dwgA,dwgB,dwgC,dwgD,dwgE,dwgF)
	For i = 0 To uBound(pst) Step 1
		For j = 0 To uBound(pst(i)) Step 1
			off = (i+1)*(cols*size*.5+size)
			pline = Rhino.AddPolyline(array(array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0),array(pst(i)(j)(0)(1)(0)+off,pst(i)(j)(0)(1)(1),0),array(pst(i)(j)(0)(2)(0)+off,pst(i)(j)(0)(2)(1),0),array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0)))
			Call Rhino.ObjectColor(pline,pst(i)(j)(1))
			If pst(i)(j)(2) = 0 Then
				clrCnt(0) = clrCnt(0)+1
			ElseIf pst(i)(j)(2) = 1 Then
				clrCnt(1) = clrCnt(1)+1
			ElseIf pst(i)(j)(2) = 2 Then
				clrCnt(2) = clrCnt(2)+1
			End If
	Next
	Next
	Dim cutPt(3)
	t=0
	For i = 0 To 2 Step 1
		r=0
		s=0
		For j = 0 To clrCnt(i) Step 1
			
			If s*size*.5 > width Then
				r=r+1
				s=0
			End If
			If r*size > height Then
				r=0
				t=t+width+size*2
			End If
			
			If r Mod(2) Then
				ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
			Else
				ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
			End If
			
			If s Mod(2) Then
				pt = array(ptA(0),ptA(1),ptA(2))
				cutPt(0) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
				cutPt(1) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
				cutPt(2) = array(pt(0),pt(1)-y+c*.5,pt(2))
				cutPt(3) = cutPt(0)
				Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
			Else
				pt = array(ptA(0),ptA(1)-c*.5,ptA(2))
				cutPt(0) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
				cutPt(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
				cutPt(2) = array(pt(0),pt(1)+y-c*.5,pt(2))
				cutPt(3) = cutPt(0)
				Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
			End If
			
			s=s+1
	Next
	t=t+width+size*2
	Next
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function
	
	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then 
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If
		
	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If
	
	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
	
	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j
			
			If x>w Then
				x = w
			End If
			
			If y>h Then
				y = h
			End If
			
			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)
			
		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
	arrayValue = Null
	Dim i,j
	ReDim val(rows), arrVal(cols)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			val(j) = value
		Next
		arrVal(i) = val
	Next
	arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
	hatch = Null
	Dim layer
	layer = Rhino.CurrentLayer()
	Call Rhino.CurrentLayer(strLayer)
	Call Rhino.SelectObject(strObject)
	Call Rhino.Command("-Hatch P S _Enter")
	Call Rhino.Command("SelNone")
	Call Rhino.CurrentLayer(layer)
End Function

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic.net>
'Script version Thursday, May 15, 2008 9:24:31 AM

Call Main()
Sub Main()
	Dim arrClr
	
	Dim arrItems, arrValues, arrResults,blnResult
	arrItems = array("Columns","Rows","Size","Width","Height")
	arrValues= array(10,10,2,32,18)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
	If isNull(arrResults(0)) Then Exit Sub
	arrClr = arrImageSample(arrResults(0)*4, arrResults(1)*2)
	If isNull(arrClr) Then Exit Sub
	
	Call Rhino.EnableRedraw(False)
	Call TetraGrid(CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(3)),CDbl(arrResults(4)),CDbl(arrResults(2)),arrClr(6))
	Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue)
	cols=cols*4
	TetraGrid = Null
	Dim i,j,k,r,s,t
	Dim x,y,z,c, za
	Dim pt, ptA, clrtype
	'calculate tetrahedron construction ratio's
	x = size
	y = size*cos(PI/6)
	c= size*.5/sin(PI/3)
	z = sqr(x^2-c^2)
	'create packed tetrahedron points
	ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)				
			Else
				ptA = array(x*.5*i,(y+c*1.5)*j,0)
			End If
			'type A
			If arrValue(i)(r)< .4 Then
				za = -z
			Else
				za = z
			End If
			pt = array(ptA(0),ptA(1)-c*2,ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)+za)
			ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
			
			'type B
			If arrValue(i)(r)< .4 Then
				za = -z
			Else
				za = -z
			End If
			pt = array(ptA(0),ptA(1),ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)+za)
			ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
	Next
	ptSet(i) = ptTetra
	Next
	Dim shnVal,lyrName,lyrClr,mtrl(2)
	'create color layers and material colors
	shnVal = 1
	lyrName = array("black","grey","white")
	lyrClr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
	For i = 0 To 2 Step 1
		If Rhino.IsLayer(lyrName(i)) = False Then
			Call Rhino.AddLayer(lyrName(i),lyrClr(i))
			mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
			Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		Else 
			mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		End If
	Next
	
	'create and color surfaces tetrahedron points
	Dim clr, count, upDn
	Dim dwgA(),dwgB(),dwgC()
	ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
	ReDim srfBln(rows*2-2),blnSet(cols-1)
	ReDim srfBlnA(rows*2-2),blnSetA(cols-1)
	r=0:s=0:t=0
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			'adjust for surface normal
			If arrValue(i)(j)< .4 Then
				clr = RGB(1,1,1)
				clrtype = 0
				upDn = 0
			ElseIf arrValue(i)(j) >= .4 And arrValue(i)(j)< .8 Then
				clr = RGB(175,175,175)
				clrtype = 1
				upDn = 1
			Else
				clr = RGB(255,255,255)
				clrtype = 2
				upDn = 1
			End If

			If j Mod(2) Then
				ReDim Preserve dwgA(r)
				srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)))
				dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
				r=r+1
				srfBln(j) = False
			Else
				ReDim Preserve dwgA(r)
				srf(0) = Rhino.AddSrfPt(array(ptSet(i)(j)(1),ptSet(i)(j)(2),ptSet(i)(j)(3)))
				dwgA(r)= array(array(ptSet(i)(j)(1),ptSet(i)(j)(3),ptSet(i)(j)(2)),clr,clrtype)
				If arrValue(i)(j) >= .8 Then
					srfBln(j) = True
				Else
					srfBln(j) = False
				End If
				If arrValue(i)(j) < .4 Then
					srfBlnA(j) = True
				Else
					srfBlnA(j) = False
				End If				
			End If
							
			Call Rhino.ObjectColor(srf(0),clr)
			Call Rhino.ObjectLayer(srf(0),lyrName(clrtype))
			
			If j Mod(2) And arrValue(i)(j)> .4 Then
			Else					
				For k = 1 To 3 Step 1			
					If k<3 Then
						srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
						If  upDn= 1 Then
							ReDim Preserve dwgB(s)
							dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgC(t)
							dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)),clr,clrtype)
							t=t+1
						End If
					Else
						srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
						If  upDn= 1 Then
							ReDim Preserve dwgB(s)
							dwgB(s)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgC(t)
							dwgC(t)= array(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)),clr,clrtype)
							t=t+1
						End If
					End If
					Call Rhino.ObjectColor(srf(k),clr)
					Call Rhino.ObjectLayer(srf(k),lyrName(clrtype))
				Next
			End If
	Next
	blnSet(i) = srfBln
	blnSetA(i)= srfBlnA
	Next
	
	Dim dwgD(),dwgE(),dwgF()
	Dim blnPair, tempSrf, tempPts
	blnPair = array(blnSet,blnSetA)
	r=0:s=0:t=0
	For i = 0 To cols-1 Step 1
		For j = 0 To rows*2-2 Step 1
			'top plates band A
			If ptSet(i)(j)(2)(2) < 0 Or ptSet(i)(j)(3)(2) < 0 Or ptSet(i)(j)(0)(2) < 0 Then
				clr = RGB(1,1,1)
				clrtype=0
				upDN=1
			Else
				clr = RGB(255,255,255)
				clrtype=2
				upDN=0
			End If
			
			If i < cols-2 Then
				If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i+2)(j) = True Then
					tempSrf = Rhino.AddSrfPt(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)))
					ReDim Preserve dwgD(r)
					dwgD(r)= array(array(ptSet(i+1)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(0)),clr,clrtype)
					r=r+1
					Call Rhino.ObjectColor(tempSrf,clr)
					Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
				End If
			End If
			
			'top plates band B
			If i > 0 And i < cols-2 And j < rows*2-3 Then
				If i Mod(2) Then
					If blnPair(0)(i)(j) = True And blnPair(0)(i+1)(j+2) = True And blnPair(0)(i-1)(j+2) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)))
						ReDim Preserve dwgD(r)
						dwgD(r)= array(array(ptSet(i)(j)(0),ptSet(i-1)(j+2)(0),ptSet(i+1)(j+2)(0)),clr,clrtype)
						r=r+1
					End If
				Else
					If blnPair(0)(i)(j+2) = True And blnPair(0)(i+1)(j) = True And blnPair(0)(i-1)(j) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)))	
						ReDim Preserve dwgD(r)
						dwgD(r)= array(array(ptSet(i)(j+2)(0),ptSet(i-1)(j)(0),ptSet(i+1)(j)(0)),clr,clrtype)
						r=r+1
					End If
				End If
				Call Rhino.ObjectColor(tempSrf,clr)
				Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
			End If
			
			For k = 0 To 1 Step 1
				'front faces all
				If i < cols-2 Then
					If blnPair(k)(i)(j) = True And blnPair(k)(i+2)(j) = True Then
						tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)))
						Call Rhino.ObjectColor(tempSrf,clr)
						Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
						If  upDn= 1 Then
							ReDim Preserve dwgE(s)
							dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgF(t)
							dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+2)(j)(0),ptSet(i)(j)(2)),clr,clrtype)
							t=t+1
						End If
					End If
				End If
			
				'side faces band A
				If i < cols-2 Then
					If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j) = True Then
						If i Mod(2) Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2)))
							tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(2))
						Else
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3)))
							tempPTs = array(ptSet(i)(j)(0),ptSet(i+1)(j)(0),ptSet(i)(j)(3))
						End If
						Call Rhino.ObjectColor(tempSrf,clr)
						Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
						If  upDn= 1 Then
							ReDim Preserve dwgE(s)
							dwgE(s)= array(tempPTs,clr,clrtype)
							s=s+1
						Else
							ReDim Preserve dwgF(t)
							dwgF(t)= array(tempPTs,clr,clrtype)
							t=t+1
						End If
					End If
				End If
			
				'side faces band B
				If i Mod(2) Then
					If i < cols-2 And j < rows*2-3 Then
						If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j+2) = True Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)))
							Call Rhino.ObjectColor(tempSrf,clr)
							Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
							If  upDn= 1 Then
								ReDim Preserve dwgE(s)
								dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
								s=s+1
							Else
								ReDim Preserve dwgF(t)
								dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j+2)(0),ptSet(i)(j)(3)),clr,clrtype)
								t=t+1
							End If
						End If
					End If
				Else
					If i < cols-2 And j > 1 Then
						If blnPair(k)(i)(j) = True And blnPair(k)(i+1)(j-2) = True Then
							tempSrf = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)))
							Call Rhino.ObjectColor(tempSrf,clr)
							Call Rhino.ObjectLayer(tempSrf,lyrName(clrtype))
							If  upDn= 1 Then
								ReDim Preserve dwgE(s)
								dwgE(s)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
								s=s+1
							Else
								ReDim Preserve dwgF(t)
								dwgF(t)= array(array(ptSet(i)(j)(0),ptSet(i+1)(j-2)(0),ptSet(i)(j)(2)),clr,clrtype)
								t=t+1
							End If
						End If
					End If
				End If
			Next
		Next
	Next
	clr = array(RGB(1,1,1),RGB(175,175,175),RGB(255,255,255))
	Dim pst,pline,off,clrCnt(2)
	clrCnt(0) = 0:clrCnt(1) = 0:clrCnt(2) = 0
	pst = array(dwgA,dwgB,dwgC,dwgD,dwgE,dwgF)
	For i = 0 To uBound(pst) Step 1
		For j = 0 To uBound(pst(i)) Step 1
			off = (i+1)*(cols*size*.5+size)
			pline = Rhino.AddPolyline(array(array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0),array(pst(i)(j)(0)(1)(0)+off,pst(i)(j)(0)(1)(1),0),array(pst(i)(j)(0)(2)(0)+off,pst(i)(j)(0)(2)(1),0),array(pst(i)(j)(0)(0)(0)+off,pst(i)(j)(0)(0)(1),0)))
			Call Rhino.ObjectColor(pline,pst(i)(j)(1))
			If pst(i)(j)(2) = 0 Then
				clrCnt(0) = clrCnt(0)+1
			ElseIf pst(i)(j)(2) = 1 Then
				clrCnt(1) = clrCnt(1)+1
			ElseIf pst(i)(j)(2) = 2 Then
				clrCnt(2) = clrCnt(2)+1
			End If
	Next
	Next
	Dim cutPt(3)
	t=0
	For i = 0 To 2 Step 1
		r=0
		s=0
		For j = 0 To clrCnt(i) Step 1
			
			If s*size*.5 > width Then
				r=r+1
				s=0
			End If
			If r*size > height Then
				r=0
				t=t+width+size*2
			End If
			
			If r Mod(2) Then
				ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
			Else
				ptA = array(x*.5*s+t,(y)*r-rows*size*2,0)
			End If
			
			If s Mod(2) Then
				pt = array(ptA(0),ptA(1),ptA(2))
				cutPt(0) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
				cutPt(1) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
				cutPt(2) = array(pt(0),pt(1)-y+c*.5,pt(2))
				cutPt(3) = cutPt(0)
				Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
			Else
				pt = array(ptA(0),ptA(1)-c*.5,ptA(2))
				cutPt(0) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
				cutPt(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
				cutPt(2) = array(pt(0),pt(1)+y-c*.5,pt(2))
				cutPt(3) = cutPt(0)
				Call Rhino.ObjectColor(Rhino.AddPolyline(cutPt),clr(i))
			End If
			
			s=s+1
	Next
	t=t+width+size*2
	Next
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function
	
	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then 
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If
		
	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If
	
	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
	
	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j
			
			If x>w Then
				x = w
			End If
			
			If y>h Then
				y = h
			End If
			
			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)
			
		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
	arrayValue = Null
	Dim i,j
	ReDim val(rows), arrVal(cols)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			val(j) = value
		Next
		arrVal(i) = val
	Next
	arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
	hatch = Null
	Dim layer
	layer = Rhino.CurrentLayer()
	Call Rhino.CurrentLayer(strLayer)
	Call Rhino.SelectObject(strObject)
	Call Rhino.Command("-Hatch P S _Enter")
	Call Rhino.Command("SelNone")
	Call Rhino.CurrentLayer(layer)
End Function

This Rhino Script triangulates a surface with three pattern options

Pattern Types:

[A][A] | [A][B] | [A][B]

[A][A] | [A][B] | [B][A]

typ.0 _typ.1 _typ.2

This version of the script lays out the resulting triangular faces in a tiled grid with numbered tabs which allow for rapid reconstruction. To assemble simply match up tab numbers.

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Monday, March 23, 2009 11:03:52 AM

Call Main()
Sub Main()
	Dim surface
	surface = Rhino.GetObject("Select Surface",8,True)
	If isnull(surface) Then Exit Sub

	Dim arrValue, cols, rows, spacing, height, typ
	typ = Rhino.GetInteger("Select Triangulation Type",0,0,2)
	If isNull(typ) Then Exit Sub

	arrValue = Rhino.PropertyListBox(array("Columns","Rows","Tile Spacing","tabHeight"),array(10,10,1,0.5))
	If isNull(arrValue) Then Exit Sub

	cols = CDbl(arrValue(0))
	rows = CDbl(arrValue(1))
	spacing = CDbl(arrValue(2))
	height = CDbl(arrValue(3))

	Dim i,j,k,r,s,t
	Dim arrVals
	Dim grid,sort,edge,surf,tri(3),outline(3)

	Call Rhino.EnableRedraw(False)
	grid = arrEvalSrf(surface, cols, rows)

	arrVals = array(array(0,0,1,1,1,0),array(1,1,0,0,0,1),array(1,0,0,1,0,0),array(0,1,1,0,1,1))

	For i = 0 To 3 Step 1
		tri(i) = triangulate(surface, grid, arrVals(i))
		If i < 2 Then
			outline(i) = flatten(tri(i),True)
		Else
			outline(i) = flatten(tri(i),False)
		End If
	Next
	sort = sortTriangles(outline,typ)
	surf = sortTriangles(tri,typ)

	edge = drawTriangle(sort)

	Call tileObjects(edge,spacing+height)

	Dim blnDir

	For i = 0 To uBound(edge) Step 1
		r=0
		s=0
		For j = 0 To uBound(edge(i)) Step 1
			If j Mod(2) Then: s=s+1: t=i : Else: r=r+1: t=i+1: End If

			If typ = 0 Then
				blnDir = False
			Else
				If r Mod(2) Then
					If typ = 2 And i Mod(2) Then: blnDir = True: Else: blnDir = False: End If
				Else
					If typ = 2 And i Mod(2) Then: blnDir = False: Else: blnDir = True: End If
				End If
			End If

			Call tabMaker(edge(i)(j)(0),height,i & "." & r & "." & 0,blnDir)
			Call tabMaker(edge(i)(j)(1),height,i & "." & t & "." & 1,blnDir)
			Call tabMaker(edge(i)(j)(2),height,i & "." & s & "." & 2,blnDir)
			Call Rhino.addsrfpt(surf(i)(j))
		Next
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function arrEvalSrf(surface, cols, rows)
	arrEvalSrf = Null
	Dim i,j
	Dim pt(), arrOutput(), dom(1), stp(1)
	ReDim pt(rows), arrOutput(cols)

	dom(0) = Rhino.SurfaceDomain(surface,0)
	dom(1) = Rhino.SurfaceDomain(surface,1)

	stp(0) = (dom(0)(1)-dom(0)(0))/cols
	stp(1) = (dom(1)(1)-dom(1)(0))/rows

	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			pt(j) = Rhino.EvaluateSurface(surface,array(dom(0)(0)+stp(0)*i,dom(1)(0)+stp(1)*j))
		Next
		arrOutput(i) = pt
	Next

	arrEvalSrf = arrOutput
End Function
Function triangulate(surface, arrPoints, arrValues)
	triangulate = Null
	Dim i,j,k,r, cols, rows
	Dim pts(), arrOutput(), pt(3), maxVal(1)

	maxVal(0) = Rhino.Max(array(arrValues(0),arrValues(2),arrValues(4)))
	maxVal(1) = Rhino.Max(array(arrValues(1),arrValues(3),arrValues(5)))

	cols = ubound(arrPoints)-maxVal(0)

	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))-maxVal(1)
		ReDim pts(rows)
		For j = 0 To rows Step 1
			r=0
			For k = 0 To 2 Step 1
				pt(k) = arrPoints(i+arrValues(r))(j+arrValues(r+1))
				r=r+2
			Next
			pt(3) = pt(0)
			pts(j) = pt
			'Call Rhino.AddPolyline(pts(j))
		Next
		arrOutput(i) = pts
	Next

	triangulate = arrOutput
End Function
Function flatten(arrPoints,blnUp)
	flatten = Null
	Dim i,j,k, cols, rows
	Dim pts(), arrOutput(), tPts(3), pt(3), temp
	cols = uBound(arrPoints)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))
		ReDim pts(rows)
		For j = 0 To rows Step 1
			For k = 0 To 3 Step 1
				tPts(k) = Rhino.AddPoint(arrPoints(i)(j)(k))
			Next
			temp = Rhino.OrientObjects(tPts,array(arrPoints(i)(j)(0),arrPoints(i)(j)(1),arrPoints(i)(j)(2)), array(array(0,0,0),array(1,0,0),array(0,1,0)))
			If blnUp = True Then
				Call Rhino.RotateObjects(temp,array(0,0,0),180,Rhino.WorldXYPlane()(2),False)
			End If

			For k = 0 To 3 Step 1
				Pt(k) = Rhino.PointCoordinates(temp(k))
				Call Rhino.DeleteObject(temp(k))
			Next
			pts(j) = pt
		Next
		arrOutput(i) = pts
	Next

	flatten = arrOutput
End Function
Function drawTriangle(arrPoints)
	drawTriangle = Null
	Dim i,j,k, cols, rows
	Dim arrTemp(), arrOutput(),lines(2)
	cols = uBound(arrPoints)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))
		ReDim arrTemp(rows)
		For j = 0 To rows Step 1
			For k = 0 To 2 Step 1
				lines(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
			Next
			Call Rhino.ObjectColor(lines,RGB(255,0,0))
			arrTemp(j) = lines
		Next
		arrOutput(i) = arrTemp
	Next

	drawTriangle = arrOutput
End Function
Function sortTriangles(arrSet,blnType)
	sortTriangles = Null
	Dim i,j,k,r,a,b, cols, rows
	Dim arrTemp(), arrOutput()
	cols = uBound(arrSet(0))
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrSet(0)(i))
		r=1
		For j = 0 To rows Step 1
			If blnType = 0 Then
				a = array(1,1)
			ElseIf blnType = 1 Then
				a = array(1,2)
			ElseIf blnType = 2 Then
				a = array(2,2)
			End If

			If i Mod(a(0)) Then
				If j Mod(a(1)) Then
					b = array(0,1)
				Else
					b = array(2,3)
				End If
			Else
				If j Mod(a(1)) Then
					b = array(2,3)
				Else
					b = array(0,1)
				End If
			End If
			ReDim Preserve arrTemp(r)
			arrTemp(r-1) = arrSet(b(0))(i)(j)
			arrTemp(r) = arrSet(b(1))(i)(j)
			r=r+2
		Next
		arrOutput(i) = arrTemp
	Next

	sortTriangles = arrOutput
End Function
Function tileObjects(arrObjects,spacing)
	tileObjects = Null
	Dim i,j,cols,rows,arrOutput(),arrTemp()
	Dim origin, tDis, dist, bBox()
	origin = array(0,0,0)

	cols = uBound(arrObjects)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = uBound(arrObjects(i))
		ReDim bBox(rows),arrTemp(rows)
		tDis = 0
		For j = 0 To rows Step 1
			bBox(j) = Rhino.BoundingBox(arrObjects(i)(j))
			dist = Rhino.Distance(bBox(j)(0),bBox(j)(1))
			If j = 0 Then
				Call Rhino.MoveObjects(arrObjects(i)(j),bBox(j)(0),origin)
			Else
				Call Rhino.MoveObjects(arrObjects(i)(j),bBox(j)(0),bBox(j-1)(3))
				Call Rhino.MoveObjects(arrObjects(i)(j),array(0,0,0),array(0,spacing,0))
			End If
			bBox(j) = Rhino.BoundingBox(arrObjects(i)(j))

			If tDis < dist Then
				tDis = dist
				origin = array(bBox(j)(1)(0)+spacing,0,0)
			End If
			arrTemp(j) = arrObjects(i)(j)
		Next
		arrOutput(i) = arrTemp
	Next
	tileObjects = arrOutput
End Function
Function tabMaker(curve,depth,text,blnDirection)
	tabMaker = Null
	Dim arrOutput, tPlane, pt(3), txt
	tPlane = Rhino.ViewCPlane()
	Call Rhino.ViewCPlane(,Rhino.WorldXYPlane())
	pt(0) = Rhino.CurveMidPoint(curve)
	If blnDirection = True Then
		pt(1) = Rhino.CurveStartPoint(curve)
		pt(2) = Rhino.CurveEndPoint(curve)
	Else
		pt(2) = Rhino.CurveStartPoint(curve)
		pt(1) = Rhino.CurveEndPoint(curve)
	End If
	pt(3) = Rhino.PointAdd(pt(0),Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(pt(1),pt(2))),depth),90,Rhino.WorldXYPlane()(3)))
	arrOutput = Rhino.AddPolyline(array(pt(1),pt(3),pt(2)))
	txt = Rhino.AddText(text,pt(0),depth*0.3)
	Call Rhino.ObjectColor(txt,RGB(0,255,0))
	Call Rhino.OrientObject(txt,array(pt(0),array(pt(0)(0)+1,pt(0)(1),pt(0)(2)),array(pt(0)(0),pt(0)(1)+1,pt(0)(2))),array(pt(0),pt(1),pt(3)))
	Call Rhino.ViewCPlane(,tPlane)
	tabMaker = arrOutput
End Function

What do you do with a couple thousand left over chipboard triangles, some paint, and a little spare time. You make the TETRAbit tabletop. With an A and B side creating a flat surfaced top for function and a contact point base to minimize exposure the resulting plate system is surprisingly strong. Composing three individual images into a pixelated composition, results in a piece that well, I just like. Sometimes a project should just be for the sake of existence. The rhinoscript itself produces a three dimensional model for testing, a 2 dimensional map of the two layers for reference, and laser cut templates which calculates and separates the total number of triangles required to complete the pattern.

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, May 15, 2008 9:24:31 AM

Call Main()
Sub Main()
	Dim arrItems, arrValues, arrResults,blnResult,arrClr(2)
	arrItems = array("Columns","Rows","Size","Width","Height")
	arrValues= array(10,10,2,32,18)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
	
	blnResult = Rhino.GetBoolean("ColorCells",array("fillType","outline","hatch","cutTemplate","No","Yes"),array(False,False))
	If isNull(blnResult) Then Exit Sub

	Dim i
	For i = 0 To 2 Step 1
		arrClr(i) = arrImageSample(arrResults(0)*4, arrResults(1)*2)
		If isNull(arrClr(i)) Then Exit Sub
	Next
		
	Call Rhino.EnableRedraw(False)
	Call TetraGrid(arrResults(0),arrResults(1),arrResults(3),arrResults(4),arrResults(2),array(array(arrClr(0)(0),arrClr(0)(1),arrClr(0)(2)),array(arrClr(1)(0),arrClr(1)(1),arrClr(1)(2)),array(arrClr(2)(0),arrClr(2)(1),arrClr(2)(2))),blnResult(0),blnResult(1))
	Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue,blnHatch,blnCut)
	cols=cols*4
	TetraGrid = Null
	Dim i,j,k,m,n,p,r,s
	Dim x,y,z,c, za
	Dim pt, ptA
	'calculate tetrahedron construction ratio's
	x = size
	y = size*cos(PI/6)
	c= size*.5/sin(PI/3)
	z = sqr(x^2-c^2)
	'create packed tetrahedron points
	ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
	ReDim ptB(rows*2),ptSetB(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)				
			Else
				ptA = array(x*.5*i,(y+c*1.5)*j,0)
			End If
			
			'type A
			pt = array(ptA(0),ptA(1)-c*2,ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)-z)
			ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
	
			'base type A
			pt = array(ptT(1)(0),ptT(1)(1)+c*1.5+y,ptT(1)(2))
			ptT(0) = array(pt(0),pt(1),pt(2))
			ptT(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2)-z)
			ptT(2) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2)-z)
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2)-z)
			ptB(r-1) = ptT
			'base type B
			ptT(0) = array(pt(0),pt(1),pt(2)-z*2)
			ptB(r) = ptT
			
			
			'type B
			pt = array(ptA(0),ptA(1),ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)-z)
			ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
		
	Next
	ptSet(i) = ptTetra
	ptSetB(i) = ptB
	Next
	
	'define colors and materials
	Dim mtrl(5), lyrName, lyrClr, shnVal	
	If Rhino.IsLayer("overlay") = False Then
		Call Rhino.AddLayer("overlay",RGB(0,0,0))
	End If

	shnVal = 1
	lyrName = array("magenta","green","blue","yellow","white","black")
	lyrClr = array(RGB(235,95,255),RGB(45,145,60),RGB(80,165,255),RGB(255,255,45),RGB(255,255,255),RGB(0,0,0))
	For i = 0 To 5 Step 1
		If Rhino.IsLayer(lyrName(i)) = False Then
			Call Rhino.AddLayer(lyrName(i),lyrClr(i))
			mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
			Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		Else 
			mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		End If
	Next
	
	ReDim clr(rows*2-1), clrSet(cols), triSet(2)
	ReDim lyr(rows*2-1), lyrSet(cols), layers(2)
	ReDim mat(rows*2-1), matSet(cols), materl(2)
	Dim ba,bl,gr,ma,ye,wh
	ba = 0: bl = 0: gr = 0: ma = 0: ye = 0: wh = 0
	'determine color range
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			For k = 0 To 2 Step 1
				
				If arrValue(k)(0)(i)(j)=arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)=arrValue(k)(2)(i)(j) Then
					If arrValue(k)(0)(i)(j) < .5 Then
						triSet(k) = RGB(0,0,0)
						layers(k) = "black"
						materl(k) = mtrl(5)
						ba = ba+1
					End If
					If arrValue(k)(0)(i)(j) >= .5 Then
						triSet(k) = RGB(255,255,255)
						layers(k) = "white"
						materl(k) = mtrl(4)
						wh = wh+1
					End If
						
				End If
				'magenta
				If arrValue(k)(0)(i)(j)>arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)>arrValue(k)(2)(i)(j) Then
					triSet(k) = RGB(235,95,255)
					layers(k) = "magenta"
					materl(k) = mtrl(0)
					ma = ma+1
				End If
				'green
				If arrValue(k)(1)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(1)(i)(j)>arrValue(k)(2)(i)(j) Then
					triSet(k) = RGB(45,145,60)
					layers(k) = "green"
					materl(k) = mtrl(1)
					gr = gr+1
				End If
				'blue
				If arrValue(k)(2)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(2)(i)(j)>arrValue(k)(1)(i)(j) Then
					triSet(k) = RGB(80,165,255)
					layers(k) = "blue"
					materl(k) = mtrl(2)
					bl = bl+1
				End If
				'yellow
				If arrValue(k)(0)(i)(j)>.7 And arrValue(k)(1)(i)(j)>.7 And arrValue(k)(2)(i)(j)<.1 Then
					triSet(k) = RGB(255,255,45)
					layers(k) = "yellow"
					materl(k) = mtrl(3)
					ye = ye+1
				End If
				'white
				If arrValue(k)(0)(i)(j)>.8 And arrValue(k)(1)(i)(j)>.8 And arrValue(k)(2)(i)(j)>.8 Then
					triSet(k) = RGB(255,255,255)
					layers(k) = "white"
					materl(k) = mtrl(4)
					wh = wh+1
				End If
				'black
				If arrValue(k)(0)(i)(j)<.2 And arrValue(k)(1)(i)(j)<.2 And arrValue(k)(2)(i)(j)<.2 Then
					triSet(k) = RGB(0,0,0)
					layers(k) = "black"
					materl(k) = mtrl(5)
					ba = ba+1
				End If
	Next
	clr(j) = triSet
	lyr(j) = layers
	mat(j) = materl
	Next
	clrSet(i) = clr
	lyrSet(i) = lyr
	matSet(i) = mat
	Next
	If blnCut = True Then
		' create codified cut template
		Dim cutSet, cutCnt, center, cen, ptCen(3)
		cutSet = array(ma,gr,bl,ye,wh,ba)
		m=0
	
		For i = 0 To 5 Step 1
			k=0
			n=0
			p=0
			cutCnt = cutSet(i)
			Call Rhino.AddText(lyrName(i),array(m*(width+3),-height-1,0),.25)
	
			For j = 0 To cutCnt-1 Step 1
				If j*.5*x- CDbl(width)*k > CDbl(width) Then
					k=k+1
					n=0
				End If
			
				If k*(y+c*1.5)*.5 - p*CDbl(height) > CDbl(height) Then
					m=m+1
					n=0
					p=p+1
				End If
			
				center = array(x*.5*n+m*(width+3),(y+c*1.5)*.5*k-(p+1)*height,0)
				'Call Rhino.AddText(j,center)
			
				If j Mod(2) Then
					cen = array(center(0),center(1)+c*.5,center(2))
					ptCen(0) = array(cen(0)-x*.5,cen(1)+c*.5,cen(2))
					ptCen(1) = array(cen(0)+x*.5,cen(1)+c*.5,cen(2))
					ptCen(2) = array(cen(0),cen(1)-y+c*.5,cen(2))
					ptCen(3) = ptCen(0)
				Else
					cen = array(center(0),center(1),center(2))
					ptCen(0) = array(cen(0)-x*.5,cen(1)-c*.5,cen(2))
					ptCen(1) = array(cen(0)+x*.5,cen(1)-c*.5,cen(2))
					ptCen(2) = array(cen(0),cen(1)+y-c*.5,cen(2))
					ptCen(3) = ptCen(0)
				End If
				Call Rhino.ObjectColor(Rhino.AddPolyline(ptCen),lyrClr(i))
				n=n+1
				
		Next
		m=m+1
		Next
	End If
		
	'create and color surfaces tetrahedron points	
	Dim count, offset, cpy
	ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
	ReDim dwgsA(rows*2-2),dwgSetA(cols-1), dwgA(3)
	ReDim dwgsB(rows*2-2),dwgSetB(cols-1), dwgB(3)
	ReDim srfsB(rows*2-2),srfSetB(cols-1), srfB(3)	
	ReDim srfBln(rows*2-2),blnSet(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			offset = cols*.5*size+size*2
			'create tetra surfaces and drawings
			
			For k = 1 To 3 Step 1
				If k<3 Then
					
					srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
					dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(k+1)(0)+offset,ptSet(i)(j)(k+1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
						Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				Else
					srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
					dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(1)(0)+offset,ptSet(i)(j)(1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
						Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				End If
			Next
			'create underside structure
			offset = (cols*.5*size+size*2)*2
			For k = 1 To 3 Step 1
				
				If k<3 Then
					srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(k+1)))
					dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(k+1)(0)+offset,ptSetB(i)(j-1)(k+1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgB(k)),"overlay")
						Call hatch(dwgB(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				Else
					srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(1)))
					dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(1)(0)+offset,ptSetB(i)(j-1)(1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
										
					Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				End If
			Next
			
	Next
	blnSet(i) = srfBln
	Next
	
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function
	
	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then 
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If
		
	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If
	
	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
	
	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j
			
			If x>w Then
				x = w
			End If
			
			If y>h Then
				y = h
			End If
			
			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)
			
		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
	arrayValue = Null
	Dim i,j
	ReDim val(rows), arrVal(cols)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			val(j) = value
		Next
		arrVal(i) = val
	Next
	arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
	hatch = Null
	Dim layer
	layer = Rhino.CurrentLayer()
	Call Rhino.CurrentLayer(strLayer)
	Call Rhino.SelectObject(strObject)
	Call Rhino.Command("-Hatch P S _Enter")
	Call Rhino.Command("SelNone")
	Call Rhino.CurrentLayer(layer)
End Function

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Thursday, May 15, 2008 9:24:31 AM

Call Main()
Sub Main()
	Dim arrItems, arrValues, arrResults,blnResult,arrClr(2)
	arrItems = array("Columns","Rows","Size","Width","Height")
	arrValues= array(10,10,2,32,18)
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Sample Settings")
	
	blnResult = Rhino.GetBoolean("ColorCells",array("fillType","outline","hatch","cutTemplate","No","Yes"),array(False,False))
	If isNull(blnResult) Then Exit Sub

	Dim i
	For i = 0 To 2 Step 1
		arrClr(i) = arrImageSample(arrResults(0)*4, arrResults(1)*2)
		If isNull(arrClr(i)) Then Exit Sub
	Next
		
	Call Rhino.EnableRedraw(False)
	Call TetraGrid(arrResults(0),arrResults(1),arrResults(3),arrResults(4),arrResults(2),array(array(arrClr(0)(0),arrClr(0)(1),arrClr(0)(2)),array(arrClr(1)(0),arrClr(1)(1),arrClr(1)(2)),array(arrClr(2)(0),arrClr(2)(1),arrClr(2)(2))),blnResult(0),blnResult(1))
	Call Rhino.EnableRedraw(True)
End Sub
Function TetraGrid(cols,rows,width,height,size,arrValue,blnHatch,blnCut)
	cols=cols*4
	TetraGrid = Null
	Dim i,j,k,m,n,p,r,s
	Dim x,y,z,c, za
	Dim pt, ptA
	'calculate tetrahedron construction ratio's
	x = size
	y = size*cos(PI/6)
	c= size*.5/sin(PI/3)
	z = sqr(x^2-c^2)
	'create packed tetrahedron points
	ReDim ptT(3),ptTetra(rows*2), ptSet(cols)
	ReDim ptB(rows*2),ptSetB(cols)
	For i = 0 To cols-1 Step 1
		r=0
		For j = 0 To rows-1 Step 1
			If i Mod(2) Then
				ptA = array(x*.5*i,(y+c*1.5)*j+c*1.5,0)				
			Else
				ptA = array(x*.5*i,(y+c*1.5)*j,0)
			End If
			
			'type A
			pt = array(ptA(0),ptA(1)-c*2,ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)-z)
			ptT(1) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
	
			'base type A
			pt = array(ptT(1)(0),ptT(1)(1)+c*1.5+y,ptT(1)(2))
			ptT(0) = array(pt(0),pt(1),pt(2))
			ptT(1) = array(pt(0)+x*.5,pt(1)-c*.5,pt(2)-z)
			ptT(2) = array(pt(0)-x*.5,pt(1)-c*.5,pt(2)-z)
			ptT(3) = array(pt(0),pt(1)+y-c*.5,pt(2)-z)
			ptB(r-1) = ptT
			'base type B
			ptT(0) = array(pt(0),pt(1),pt(2)-z*2)
			ptB(r) = ptT
			
			
			'type B
			pt = array(ptA(0),ptA(1),ptA(2))
			ptT(0) = array(pt(0),pt(1),pt(2)-z)
			ptT(1) = array(pt(0)-x*.5,pt(1)+c*.5,pt(2))
			ptT(2) = array(pt(0)+x*.5,pt(1)+c*.5,pt(2))
			ptT(3) = array(pt(0),pt(1)-y+c*.5,pt(2))
			ptTetra(r) = ptT
			r=r+1
		
	Next
	ptSet(i) = ptTetra
	ptSetB(i) = ptB
	Next
	
	'define colors and materials
	Dim mtrl(5), lyrName, lyrClr, shnVal	
	If Rhino.IsLayer("overlay") = False Then
		Call Rhino.AddLayer("overlay",RGB(0,0,0))
	End If

	shnVal = 1
	lyrName = array("magenta","green","blue","yellow","white","black")
	lyrClr = array(RGB(235,95,255),RGB(45,145,60),RGB(80,165,255),RGB(255,255,45),RGB(255,255,255),RGB(0,0,0))
	For i = 0 To 5 Step 1
		If Rhino.IsLayer(lyrName(i)) = False Then
			Call Rhino.AddLayer(lyrName(i),lyrClr(i))
			mtrl(i) = Rhino.AddMaterialToLayer(lyrName(i))
			Call Rhino.MaterialColor(mtrl(i),lyrClr(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		Else 
			mtrl(i) = Rhino.LayerMaterialIndex (lyrName(i))
			Call Rhino.MaterialShine (mtrl(i) ,shnVal)
		End If
	Next
	
	ReDim clr(rows*2-1), clrSet(cols), triSet(2)
	ReDim lyr(rows*2-1), lyrSet(cols), layers(2)
	ReDim mat(rows*2-1), matSet(cols), materl(2)
	Dim ba,bl,gr,ma,ye,wh
	ba = 0: bl = 0: gr = 0: ma = 0: ye = 0: wh = 0
	'determine color range
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			For k = 0 To 2 Step 1
				
				If arrValue(k)(0)(i)(j)=arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)=arrValue(k)(2)(i)(j) Then
					If arrValue(k)(0)(i)(j) < .5 Then
						triSet(k) = RGB(0,0,0)
						layers(k) = "black"
						materl(k) = mtrl(5)
						ba = ba+1
					End If
					If arrValue(k)(0)(i)(j) >= .5 Then
						triSet(k) = RGB(255,255,255)
						layers(k) = "white"
						materl(k) = mtrl(4)
						wh = wh+1
					End If
						
				End If
				'magenta
				If arrValue(k)(0)(i)(j)>arrValue(k)(1)(i)(j) And arrValue(k)(0)(i)(j)>arrValue(k)(2)(i)(j) Then
					triSet(k) = RGB(235,95,255)
					layers(k) = "magenta"
					materl(k) = mtrl(0)
					ma = ma+1
				End If
				'green
				If arrValue(k)(1)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(1)(i)(j)>arrValue(k)(2)(i)(j) Then
					triSet(k) = RGB(45,145,60)
					layers(k) = "green"
					materl(k) = mtrl(1)
					gr = gr+1
				End If
				'blue
				If arrValue(k)(2)(i)(j)>arrValue(k)(0)(i)(j) And arrValue(k)(2)(i)(j)>arrValue(k)(1)(i)(j) Then
					triSet(k) = RGB(80,165,255)
					layers(k) = "blue"
					materl(k) = mtrl(2)
					bl = bl+1
				End If
				'yellow
				If arrValue(k)(0)(i)(j)>.7 And arrValue(k)(1)(i)(j)>.7 And arrValue(k)(2)(i)(j)<.1 Then
					triSet(k) = RGB(255,255,45)
					layers(k) = "yellow"
					materl(k) = mtrl(3)
					ye = ye+1
				End If
				'white
				If arrValue(k)(0)(i)(j)>.8 And arrValue(k)(1)(i)(j)>.8 And arrValue(k)(2)(i)(j)>.8 Then
					triSet(k) = RGB(255,255,255)
					layers(k) = "white"
					materl(k) = mtrl(4)
					wh = wh+1
				End If
				'black
				If arrValue(k)(0)(i)(j)<.2 And arrValue(k)(1)(i)(j)<.2 And arrValue(k)(2)(i)(j)<.2 Then
					triSet(k) = RGB(0,0,0)
					layers(k) = "black"
					materl(k) = mtrl(5)
					ba = ba+1
				End If
	Next
	clr(j) = triSet
	lyr(j) = layers
	mat(j) = materl
	Next
	clrSet(i) = clr
	lyrSet(i) = lyr
	matSet(i) = mat
	Next
	If blnCut = True Then
		' create codified cut template
		Dim cutSet, cutCnt, center, cen, ptCen(3)
		cutSet = array(ma,gr,bl,ye,wh,ba)
		m=0
	
		For i = 0 To 5 Step 1
			k=0
			n=0
			p=0
			cutCnt = cutSet(i)
			Call Rhino.AddText(lyrName(i),array(m*(width+3),-height-1,0),.25)
	
			For j = 0 To cutCnt-1 Step 1
				If j*.5*x- CDbl(width)*k > CDbl(width) Then
					k=k+1
					n=0
				End If
			
				If k*(y+c*1.5)*.5 - p*CDbl(height) > CDbl(height) Then
					m=m+1
					n=0
					p=p+1
				End If
			
				center = array(x*.5*n+m*(width+3),(y+c*1.5)*.5*k-(p+1)*height,0)
				'Call Rhino.AddText(j,center)
			
				If j Mod(2) Then
					cen = array(center(0),center(1)+c*.5,center(2))
					ptCen(0) = array(cen(0)-x*.5,cen(1)+c*.5,cen(2))
					ptCen(1) = array(cen(0)+x*.5,cen(1)+c*.5,cen(2))
					ptCen(2) = array(cen(0),cen(1)-y+c*.5,cen(2))
					ptCen(3) = ptCen(0)
				Else
					cen = array(center(0),center(1),center(2))
					ptCen(0) = array(cen(0)-x*.5,cen(1)-c*.5,cen(2))
					ptCen(1) = array(cen(0)+x*.5,cen(1)-c*.5,cen(2))
					ptCen(2) = array(cen(0),cen(1)+y-c*.5,cen(2))
					ptCen(3) = ptCen(0)
				End If
				Call Rhino.ObjectColor(Rhino.AddPolyline(ptCen),lyrClr(i))
				n=n+1
				
		Next
		m=m+1
		Next
	End If
		
	'create and color surfaces tetrahedron points	
	Dim count, offset, cpy
	ReDim srfs(rows*2-2),srfSet(cols-1), srf(3)
	ReDim dwgsA(rows*2-2),dwgSetA(cols-1), dwgA(3)
	ReDim dwgsB(rows*2-2),dwgSetB(cols-1), dwgB(3)
	ReDim srfsB(rows*2-2),srfSetB(cols-1), srfB(3)	
	ReDim srfBln(rows*2-2),blnSet(cols-1)
	For i = 0 To cols-1 Step 1
		For j = 1 To rows*2-2 Step 1
			offset = cols*.5*size+size*2
			'create tetra surfaces and drawings
			
			For k = 1 To 3 Step 1
				If k<3 Then
					
					srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(k+1)))
					dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(k+1)(0)+offset,ptSet(i)(j)(k+1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
						Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				Else
					srf(k) = Rhino.AddSrfPt(array(ptSet(i)(j)(0),ptSet(i)(j)(k),ptSet(i)(j)(1)))
					dwgA(k) = Rhino.AddPolyline(array(array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0),array(ptSet(i)(j)(k)(0)+offset,ptSet(i)(j)(k)(1),0),array(ptSet(i)(j)(1)(0)+offset,ptSet(i)(j)(1)(1),0),array(ptSet(i)(j)(0)(0)+offset,ptSet(i)(j)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgA(k)),"overlay")
						Call hatch(dwgA(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srf(k),dwgA(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srf(k),dwgA(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				End If
			Next
			'create underside structure
			offset = (cols*.5*size+size*2)*2
			For k = 1 To 3 Step 1
				
				If k<3 Then
					srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(k+1)))
					dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(k+1)(0)+offset,ptSetB(i)(j-1)(k+1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
					
					If blnHatch = True Then
						Call Rhino.ObjectLayer(Rhino.CopyObject(dwgB(k)),"overlay")
						Call hatch(dwgB(k),lyrSet(i)(j)(k-1))
					End If
					
					Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				Else
					srfB(k) = Rhino.AddSrfPt(array(ptSetB(i)(j-1)(0),ptSetB(i)(j-1)(k),ptSetB(i)(j-1)(1)))
					dwgB(k) = Rhino.AddPolyline(array(array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0),array(ptSetB(i)(j-1)(k)(0)+offset,ptSetB(i)(j-1)(k)(1),0),array(ptSetB(i)(j-1)(1)(0)+offset,ptSetB(i)(j-1)(1)(1),0),array(ptSetB(i)(j-1)(0)(0)+offset,ptSetB(i)(j-1)(0)(1),0)))
										
					Call Rhino.ObjectColor(array(srfB(k),dwgB(k)),clrSet(i)(j)(k-1))
					Call Rhino.ObjectLayer(array(srfB(k),dwgB(k)),lyrSet(i)(j)(k-1))
					Call Rhino.ObjectMaterialSource (srf(k) ,0)
				End If
			Next
			
	Next
	blnSet(i) = srfBln
	Next
	
End Function
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function
	
	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then 
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If
		
	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If
	
	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
	
	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w/cols)*i
			y = int(h/rows)*j
			
			If x>w Then
				x = w
			End If
			
			If y>h Then
				y = h
			End If
			
			r(j) = RhPicture.Red(x,y)/255
			g(j) = RhPicture.Green(x,y)/255
			b(j) = RhPicture.Blue(x,y)/255
			a(j) = RhPicture.Alpha(x,y)/255
			hu(j) = RhPicture.Hue(x,y)/360
			s(j) = RhPicture.Saturation(x,y)
			u(j) = RhPicture.Luminance(x,y)
			
		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet,gValSet,bValSet,aValSet,hValSet,sValSet,uValSet)
End Function
Function arrayValue(cols,rows,value)
	arrayValue = Null
	Dim i,j
	ReDim val(rows), arrVal(cols)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			val(j) = value
		Next
		arrVal(i) = val
	Next
	arrayValue = arrVal
End Function
Function hatch(strObject,strLayer)
	hatch = Null
	Dim layer
	layer = Rhino.CurrentLayer()
	Call Rhino.CurrentLayer(strLayer)
	Call Rhino.SelectObject(strObject)
	Call Rhino.Command("-Hatch P S _Enter")
	Call Rhino.Command("SelNone")
	Call Rhino.CurrentLayer(layer)
End Function

This Rhino Script uses a series of curves, warp and weft, running parallel to the UV directions of a surface, weaving two disparate series of integers as rules for the over/under pattern.

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Friday, September 12, 2008 6:05:11 PM

Call Main()
Sub Main()
	Dim surface, arrItems, arrValues, arrResults, rhythmA,rhythmB
	surface = Rhino.GetObject("Select Surface",8)
	If isNull(surface) Then Exit Sub

	arrItems = array("Warp Strands","Weft Strands","Depth","Warp Rhythm(up,down...)","Warp Rhythm(up,down...)")
	arrValues = array(10,10,1,"2,3,2","2,3,2")
	arrResults = Rhino.PropertyListBox (arrItems, arrValues ,,"Weave Settings")

	rhythmA = split(arrResults(3),",")
	rhythmB = split(arrResults(4),",")

	Call Rhino.EnableRedraw(False)
	Call reparameterize(surface)
	Call weave(surface,CDbl(arrResults(0)),CDbl(arrResults(1)),CDbl(arrResults(2)),rhythmA,rhythmB)
	Call Rhino.EnableRedraw(True)

End Sub
Function weave(surface,cols,rows,scale,rhythmA,rhythmB)
	weave = Null

	Dim i,j,r,s,t,u,v
	Dim uDom, vDom
	Dim pts(), ptsX(1), pt()
	ReDim pts(rows),pt(cols)

	uDom = Rhino.SurfaceDomain(surface,0)(1)
	vDom = Rhino.SurfaceDomain(surface,1)(1)
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			ptsX(0) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,array((uDom/cols)*i,(vDom/rows)*j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface,array((uDom/cols)*i,(vDom/rows)*j))),scale))
			ptsX(1) = Rhino.PointAdd(Rhino.EvaluateSurface(surface,array((uDom/cols)*i,(vDom/rows)*j)),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorReverse(Rhino.SurfaceNormal(surface,array((uDom/cols)*i,(vDom/rows)*j)))),scale))
			pts(j) = ptsX
		Next
		pt(i) = pts
	Next

	Dim a,b
	Dim inverse(),inv(),pointSetA(),pointSetB()
	ReDim inverse(rows),inv(cols),pointSetA(rows),pointSetB(cols)

	Dim arrBln(), blnSt
	ReDim arrBln(cols)

	u=0
	t=rhythmA(0)
	For i = 0 To cols Step 1
		If u Mod(2) Then
			v=0
		Else
			v=1
		End If
		r=rhythmB(0)
		For j = 0 To rows Step 1
			If v Mod(2) Then
				a = 0: b = 1
			Else
				a = 1: b = 0
			End If
			r=r-1
			If r = 0 Then
				r=rhythmB(s)
				v=v+1
			End If
			If s>uBound(rhythmB)Then
				v=0
			End If

			pointSetA(j) = pt(i)(j)(a)
			inverse(j) = b
		Next
		t=t-1
		If t = 0 Then
			t=rhythmA(u)
			u=u+1

		End If
		If u>uBound(rhythmA)Then
			u=0
		End If
		inv(i) = inverse
		blnSt = False
		r=0
		For j = 0 To rows Step 1
			r = r+inverse(j)
		Next
		If r = 0 Or r = rows-1 Then
		Else
			Call Rhino.addcurve(pointSetA,3)
		End If
	Next

	For i = 0 To rows Step 1
		r=0
		For j = 0 To cols Step 1
			r = r+inv(j)(i)
		Next

		For j = 0 To cols Step 1
			pointSetB(j) = pt(j)(i)(inv(j)(i))
		Next
		If r = 0 Or r = cols-1 Then
		Else
			Call Rhino.addcurve(pointSetB,3)
		End If
	Next
End Function
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