Follow

How can I create a map of my variogram in Surfer Scripter?

This article contains a sample script for exporting the variogram for each 1 degree step, saving to a DAT, and then creating an image map of the full variogram.

To run this script:

  1. Copy the script below, or download the attached BAS file: VarioExport.BAS.
  2. In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Surfer 14\Scripter.
  3. Double click on Scripter.exe to launch Scripter.
  4. Press Ctrl+A to select all of the existing lines then press Delete.
  5. If you copied this script, press Ctrl+V to paste it into Scripter. If you downloaded it, click File | Open, select the BAS file from your downloads directory, and click Open.
  6. Click Script | Run to run the script.
     

*********

'VarioExport.bas exports the variogram curve,
'grids the data and displays it as a image 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\"
	'path1 = "c:\incoming\"
	file1 = path1+"demogrid.dat"

	Open path1+"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

	'Default tolerance is 90, set to 30 if it hasn't been changed.
	'If vario1.LagTolerance = 90 Then vario1.LagTolerance = 30
	vario1.LagTolerance=30


	'Debug.Print vario1

	For i = 0 To 179 Step 1
	 	vario1.LagDirection = i
	 	variofile1 = path1+"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(path1+"VarioCombined.dat", _
		xcol:=4,ycol:=5,zcol:=2, _
		algorithm:=Surfer.srfNaturalNeighbor)

	Set mapframe1 = shapes1.AddColorReliefMap(path1+"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\rainbow2.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

 

Updated February 13, 2017

Was this article helpful?
0 out of 0 found this helpful
Have more questions? Submit a request

0 Comments

Please sign in to leave a comment.