'============================= 'VarioExport.bas '============================= 'Exports the variogram curve, grids the data and displays it as a contour map. '============================= Sub Main '==================================== 'User-defined variables '==================================== path1 = "C:\Users\Leslie\Desktop\" file1 = path1+"demogrid.dat" '==================================== 'Gets the Surfer application. If Surfer is not open, issues an error message. 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 'If there isn't a plot document open in Surfer, issue an error message If surf.ActiveDocument.Type <> srfDocPlot Then _ GoTo errmsg Set plotdoc1 = surf.ActiveDocument surf.Caption = "Surfer "+surf.Version AppActivate "Surfer "+surf.Version 'Assigns the active plot document window and the shapes in that window to variables Set plotwin1 = surf.ActiveWindow Set shapes1 = plotdoc1.Shapes 'If there the plot document window is empty, issue an error message. If shapes1.Count = 0 Then errstr = "Variogram not present in active window." GoTo errmsg End If 'Creates a file called VarioCombined.dat to write all exported variograms to. 'Adds a header row to the VarioCombined.dat file Open path1+"VarioCombined.dat" For Output As #1 Print #1, "lag, variance, numpairs, X, Y" 'Issue an error if there is no object called "Variogram" in the plot document 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 ' Set lag tolerance to 30 vario1.LagTolerance=30 'Loop through angles 0 through 179, changing variogram settings and exporting For i = 0 To 179 Step 1 'Set the lag direction to the angle being looped over vario1.LagDirection = i 'Create a temporary file, with the angle in the title, to save the variogram export to variofile1 = path1+"Vario-"+ Format(i,"000")+".dat" 'Print the angle to the Scripter Immediate pane Debug.Print "Angle = ";i 'Export the variogram to the file that was just created vario1.Export(variofile1) Wait .1 'Read lag, variance, pairs from the exported file. 'Write these plus XY coords to the VarioCombined.dat file. pi = 3.14159265358979 Dim variovars(1 To 3) As Double 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 Wend Close 2 'Delete the exported temporary file with the angle in the name Kill variofile1 Next i 'Grid the variogram data surf.GridData4(path1+"VarioCombined.dat", xcol:=4,ycol:=5,zcol:=2, _ algorithm:=Surfer.srfNaturalNeighbor, ShowReport:=False) 'Create a color relief map from the grid file and place it next to the variogram Set mapframe1 = shapes1.AddColorReliefMap(path1+"VarioCombined.grd") mapframe1.Left = vario1.Left + vario1.Width + .5 'Zoom in so the color relief map fits the window surf.ActiveWindow.Zoom(srfZoomFitToWindow) 'Change the color of the NoData grid nodes to whilte With mapframe1.Overlays("Color Relief-VarioCombined.grd") .MissingDataColor = srfColorWhite End With End 'Message to display if there is no variogram in the plot document window 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