'VarioExport.bas exports the variogram curve. ' It uses the Surfer 8 Scripter BASIC command Split() to read the data file. ' Surfer 7 Scripter does not have this command. ' TB - 01 Oct 03. 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.AddImageMap(path1+"VarioCombined.grd") mapframe1.Left = vario1.Left + vario1.Width + .5 surf.ActiveWindow.Zoom(srfZoomFitToWindow) With mapframe1.Overlays("image map") .ColorMap.LoadFile(surf.Path+"\samples\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