'VarioExport.bas
'Create the variogram then run this script.
'Script exports the variogram curve, grids the data And displays it As a contour map.

'=============================

Sub Main
	Debug.Print "----- ";Time;" -----"
	pi = 3.14159265358979
	Dim variovars(1 To 3) As Double

	On Error Resume Next
	Set surf = GetObject(,"Surfer.Application")
	If Err <> 0 Then
		Debug.Print  Error;Err.Number
		errstr = "Can not get Surfer object."
		GoTo errmsg
	End If
	On Error GoTo 0

	Debug.Print "Surfer ";surf.Version

	If surf.ActiveDocument.Type <> srfDocPlot Then _
		GoTo errmsg
	Set plotdoc1 = surf.ActiveDocument
	surf.Caption = "Surfer "+surf.Version
	AppActivate "Surfer "+surf.Version

  Set plotwin1 = surf.ActiveWindow
	Set shapes1 = plotdoc1.Shapes

	If shapes1.Count = 0 Then
		errstr = "Variogram not present in active window."
		GoTo errmsg
	End If

	path1 = surf.Path+"\samples\"
	file1 = path1+"demogrid.dat"
	path2 = "C:\temp\"

	Open path2+"VarioCombined.dat" For Output As #1
	Print #1, "lag, variance, numpairs, X, Y"

	On Error Resume Next
	Set vario1 = shapes1("Variogram")  'Uses existing variogram created manually.
	If Err<> 0 Then
		errstr = "Can not find object named "+Chr(34)+"Variogram"+Chr(34)+"."
		GoTo errmsg
	End If
	On Error GoTo 0

	vario1.LagTolerance=90

	For i = 0 To 179 Step 1
	 	vario1.LagDirection = i
	 	variofile1 = path2+"Vario-"+ Format(i,"000")+".dat"
		Debug.Print "Angle = ";i
	 	vario1.Export(variofile1)
	 	Wait .1

		'Read lag, variance, pairs.  Write these plus XY coords.
		Open variofile1 For Input As #2

		While Not EOF(2)
			Line Input #2,a
			variovarsindex = 1
			For j = LBound(Split(a," ")) To UBound(Split(a," "))
				If Split(a," ")(j) <> "" Then
					variovars(variovarsindex) = Val(Split(a," ")(j))
					variovarsindex = variovarsindex+1
				End If
			Next j
			lag1 = variovars(1)
			variance1 = variovars(2)
			pairs1 = variovars(3)
			x = lag1 * Cos(i*pi/180) 'pi/180 converts degrees to radians.
			y = lag1 * Sin(i*pi/180)
			Print #1,lag1;",";variance1;",";pairs1;",";x;",";y
			Print #1,lag1;",";variance1;",";pairs1;",";-x;",";-y
			'Variogram grid is symmetrical.
		Wend
		Close 2
		Kill variofile1 'delete it.
	Next i

	surf.GridData(path2+"VarioCombined.dat", xcol:=4,ycol:=5,zcol:=2, algorithm:=Surfer.srfNaturalNeighbor)

	Set mapframe1 = shapes1.AddImageMap(path2+"VarioCombined.grd")
	mapframe1.Left = vario1.Left + vario1.Width + .5
	surf.ActiveWindow.Zoom(srfZoomFitToWindow)
	With mapframe1.Overlays("Color Relief-VarioCombined.grd")
		.ColorMap.LoadFile(surf.Path+"\ColorScales\YellowHigh.clr")
		.MissingDataColor = srfColorWhite
	End With

	End

	errmsg:
	Debug.Print "Error: "+errstr
	MsgBox ("Error: " + errstr + vbCrLf + vbCrLf + _
		"Open Surfer." + vbCrLf + _
		"Create a variogram in a blank plot window." + vbCrLf + _
		"Run the script.", vbCritical,"Error")


End Sub