Option Explicit
'Script written by <Chris Chalmers>
'Script copyrighted according to Creative Commons3(share & share alike)
'Script version Saturday, December 06, 2008 11:05:48 PM

Call Main()
Sub Main()

	Dim strAttractor, strXaxis, arrCurvesU, arrptU,dblDist, arrParameters(), strText, boolClosed
	Dim arrCurvePointsU(), arrCurvepointsV,arrCurvepoints,intRes, arrptStart,arrptEnd, dblLength01,dblRange
	Dim dblLength02,arrptAttractor,arrDistances(), strSurf, dblTotal, dblParam, arrBlank()
	Dim arrTemp, arrptTemp, intAnneal, boolPinch
	Dim i,j,k
	
	'get user data
	
	'strSurf=Rhino.GetObject("select base surface",8)
	arrCurvesU=Rhino.GetObjects("select curves in first direction",4)
	
	arrptAttractor=Rhino.GetPoint("select attractor Point")
	strAttractor=Rhino.addpoint(arrptAttractor)
	
	intRes=Rhino.GetInteger("curve resolution",20)
	intRes = intRes-1
	
	boolPinch=Rhino.GetString("pinch or expand?","pinch")
	
	boolClosed=Rhino.GetString("close curves?","Y")
	
	intAnneal=100
	
	'dblRange=Rhino.GetReal("attractor range",10)
	
	ReDim arrDistances(intRes)
	ReDim arrParameters(intRes)
	ReDim arrCurvepointsV(intRes)
	ReDim arrCurvepointsU(intRes)
	
	
	rhino.EnableRedraw False
	'step through U curves
	For i=0 To Ubound(arrCurvesU)
	
		'reparameterize curve(i)
		Rhino.UnselectAllObjects
		Rhino.SelectObject arrCurvesU(i)
		Rhino.Command("reparameterize 0 1")
		
		'------------record distances to attractor in an array-----------
		
		'loop through annealing cycle
		For k=0 To intAnneal
			
			'get set of points along curve to measure from
			If k=0 Then 
				'get reference points at regular spacing along curve
				arrCurvePoints=Rhino.DivideCurve(arrCurvesU(i),intRes)     
			Else
				
				'get last set of points
				arrCurvePoints=arrCurvepointsU
			End If
			
			'reset total
			dblTotal=0
		
			'loop through curve points
			For j=0 To ubound(arrCurvepoints)
			
				'get each point's distance to attractor
				
				dblDist = Rhino.Distance(arrCurvepoints(j),arrptAttractor)
				
				If boolPinch="pinch" Then
					dblDist = (dblDist+1)
				Else
					dblDist = 50/(dblDist+1)
				End If

				'add to total of all distances
				dblTotal = dblTotal + dblDist
				arrDistances(j)= dblTotal
			
			Next
		
			'loop through curve points AGAIN (now that total is added up)
			'and compare all distances to total
			For j=0 To ubound(arrCurvepointsU)
			
				'express each point's distance as parameter* (*as percentage of total of all distances)
				dblParam= (arrDistances(j)/dblTotal)
	
			
				'make new curve point based on new parameter
				arrCurvePointsU(j)= FcurveParameter(arrCurvesU(i),dblParam, 02)
			
			
				'add new curve point to V direction array
				If i=0 Then
					ReDim arrBlank(Ubound(arrCurvesU))
					arrCurvepointsV(j)=arrBlank
				End If
				
				arrCurvepointsV(j)(i) = arrCurvePointsU(j)
			
				
			Next
		Next
	Next
	
	'close surface if boolean says so....
	If boolClosed="Y" Then
		For i=0 To Ubound(arrCurvepointsV)
			
			arrTemp=arrCurvepointsV(i)
			ReDim Preserve arrTemp(ubound(arrTemp)+1)
			arrTemp(ubound(arrTemp))= arrTemp(0)
				
			
			arrCurvepointsV(i)=arrTemp
	
		Next
	End If
	
	
	For j=0 To Ubound(arrCurvepointsV)
		rhino.AddInterpCurve arrCurvepointsV(j),3
	Next
	
	rhino.EnableRedraw True
	
End Sub


Function FcurveParameter(strCurve,dblParam01,intLine)
	'returns a 3D point at the given parameter along a curve
	
	'Rhino.Print intLine
	
	Dim arrDom, dblParam0101
	
	arrDom=rhino.CurveDomain(strCurve)
	dblParam01= (arrDom(0) + ((arrDom(1)-arrDom(0))*dblParam01))
	
	FcurveParameter = Rhino.EvaluateCurve(strCurve,dblParam01)
	
End Function