Slice multiple maps to create a profile of non-adjacent layers (like a coal seam) in Surfer automation

Surfer's profile tool can be used to generate a multi-layer cross section of continuous or adjacent subsurface formations.  If the formations you're studying are not adjacent, a coal seam for example, then the grid slice command and a base map must be used to model the results. 

The sample script below slices formation tops and bottoms with a single BLN file and overlays them  in one map to create a discontinuous cross section. To run the script, you must have grid files for the tops and bottoms of various formations.

To run this script:

  1. Copy the script below, or download the attached BAS file: SliceNonAdjacentFormations.BAS.
  2. In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Surfer.
  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. In the User-defined variables section of the script, near the top, adjust the NumForm value to the number of formations you have top/bottom grid files for, and adjust the path1 as the input and output directory.
  7. Click Script | Run to run the script.

Surfer slice showing two coal seams.

Sub Main
'Initialize Surfer
	Dim SurferApp, Plot As Object
	Set SurferApp = CreateObject("Surfer.Application")
	SurferApp.Visible = True
	Set Plot = SurferApp.Documents.Add

'Print the Surfer version number and then delete it from the Immediate pane
	Debug.Print SurferApp.Version

'User-defined variables
	path1 = "C:\surfer\"     'Input and output file path
	NumForm = 2     'Number of desired slice formations
'Prompt user  for BLN file
	BLN$ = GetFilePath( , "bln",path1, "BLN for slice")
	If BLN$ ="" Then End

'Loop through number of slice formations
For i=1 To NumForm
	'Prompt user for top grid
	Top$ = GetFilePath( , "grd;dem;ddf",path1, "Top of Grid of Formation"+Format(i))
	If Top$ ="" Then End

	'Prompt user for bottom grid
	Bottom$ = GetFilePath( , "grd;dem;ddf",path1, "Bottom of Grid of Formation"+Format(i))
	If Bottom$ ="" Then End

        'Slice GRD files
	SurferApp.GridSlice(InGrid:=Top$, BlankFile:=BLN$, OutDataFile:= Top$+i+".dat")
	SurferApp.GridSlice(InGrid:=Bottom$, BlankFile:=BLN$, OutDataFile:= Bottom$+i+".dat")

	'Rearrange DAT and saves for Top
	Dim Wks, WksRange, WksRange2, WksRange3, WksRange4, WksRange5 As Object
	Set Wks = SurferApp.Documents.Open(FileName:=Top$+i+".dat")
	Set WksRange = Wks.Columns(Col1:=1, Col2:=2)

	'Cut column C and pastes it into column B
	Set WksRange2 = Wks.Columns(Col1:=3)
	Set WksRange3 = Wks.Columns(Col1:=2)

	'Cut column D and pastes it into column A
	Set WksRange4 = Wks.Columns(Col1:=4)
	Set WksRange5 = Wks.Columns(Col1:=1)

	'Save the file

	'Rearrange DAT and saves for Bottom
	Dim Wks1, WksRange6, WksRange7, WksRange8, WksRange9, WksRange10 As Object
	Set Wks1 = SurferApp.Documents.Open(FileName:=Bottom$+i+".dat")
	Set WksRange6 = Wks1.Columns(Col1:=1, Col2:=2)

	'Cut column C and pastes it into column B
	Set WksRange7 = Wks1.Columns(Col1:=3)
	Set WksRange8 = Wks1.Columns(Col1:=2)

        'Cut column D and pastes it into column A
	Set WksRange9 = Wks1.Columns(Col1:=4)
	Set WksRange10 = Wks1.Columns(Col1:=1)

	'Save the file as a BLN

	'Combine the DATs into a single BLN
	Dim WksRange11, WksRange12, WksRange13, WksRange14, WksRange15, WksRange16 As Object

	'Add a new column with the row number
        Wks1.Transform3 (RangeMin:=1, RangeMax:= WksRange10.Count, Equation:="C=row()")

	'Sort descending by new column C to invert the data
	Set WksRange11 = Wks1.Columns(Col1:=1,Col2:=3)
        WksRange11.Sort(Col1:=3, Order1:=wksSortDescending, Header:=False, MatchCase:=False)

	'Copy all data
	Set WksRange12 = Wks1.Cells(Col:=1, LastCol:=2, Row:=1, LastRow:=WksRange10.Count)

	'Paste in the bottom data into the top bln
	Set WksRange13 = Wks.Cells(Col:=1, Row:=WksRange5.Count+1)

	'Copy row 1
	Set WksRange14 = Wks.Rows(Row1:=1)

	'Paste into the first empty row to close the polygon
	Set WksRange15 = Wks.Cells(Col:=1, Row:=WksRange5.Count+1)

	'Count the number of rows and puts that into an empty row at the top of the file
	'This is the BLN header row
        nrows = WksRange5.Count
	Set WksRange16 = Wks.Cells("A1")
	WksRange16.Value = nrows

	'Save the file and close the worksheet windows

	'Create Base Map
	Set MapFrame = Plot.Shapes.AddBaseMap(ImportFileName:=Top$+i+"Combined.bln")
	Set BaseLayer = MapFrame.Overlays(1)
Next i

'Select all maps and overlays them into one map frame
Set NewMapFrame = Plot.Selection.OverlayMaps

'Update the scale of the map in the y direction to be visible
NewMapFrame.yLength = 2

'Fill each layer with a different color
For j=1 To NumForm
	NewMapFrame.Overlays(j).Fill.Pattern = "Solid"
	NewMapFrame.Overlays(j).Fill.ForeColorRGBA.Red = r+((j-1)*Interval)
	NewMapFrame.Overlays(j).Fill.ForeColorRGBA.Green = g+((j-1)*Interval)
	NewMapFrame.Overlays(j).Fill.ForeColorRGBA.Blue = b+((j-1)*Interval)
Next j
End Sub


Updated December 2021

Was this article helpful?
0 out of 0 found this helpful



Please sign in to leave a comment.