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.Print(j)
		Call Rhino.AddObjectToGroup(arrObjects(i),CStr("Group_" & j))
	Next

	Call Rhino.EnableRedraw(True)

End Sub

   

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

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