How can I slice formations to create a multi-layer cross section using Surfer automation?

This article contains a sample script for slicing formation tops and bottoms with a single BLN file and overlaying them together in one map to create a cross section. One use for this is coal seam modeling, 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: SliceFormations.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. In the USER VARIABLES section of the script, near the top, adjust the NumForm value to the number of formations you have top/bottom grid files for.
7. Click Script | Run to run the script.

Once the script is completed, you end up with base layer for each formation, and each base layer has a top and bottom surface polyline. The next steps are to connect the polylines, convert it to a polygon and fill with the desired fill. These steps must be done manually because for now, the commands are not yet supported in automation. For example, after the script is complete:

1. Right click over one of the Base layers in the Contents window and click Edit Group.
2. Select both polylines in the base layer and click Features | Edit Polylines | Connect Polylines.
3. Click Features | Change Type | Change Type | Polyline to Polygon.
4. In the Properties window, click the Fill tab and set the fill properties to whatever you want.
5. Right click over the Base layer in the Contents window and click Stop Editing Group.
6. Repeat for all base layers. 

*********

Sub Main
	Dim SurferApp As Object
	Set SurferApp = CreateObject("Surfer.Application")
	Debug.Print SurferApp.Version
	SurferApp.Visible = True
	Dim Plot As Object
	Set Plot = SurferApp.Documents.Add
	Debug.Clear

'************************* USER VARIABLES

	path1 = "C:\Surfer\Slice\"
	NumForm = 2

'************************* END USER VARIABLES

'Input box for BLN file
	BLN$ = GetFilePath( , "bln",path1, "BLN for slice")
	If BLN$ ="" Then End

For i=1 To NumForm
	'Input box for Top Grid
	Top$ = GetFilePath( , "grd;dem;ddf",path1, "Top of Grid of Formation"+Format(i))
	If Top$ ="" Then End

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

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

'Rearranges DAT and saves as BLN for Top
	Dim Wks As Object
	Set Wks = SurferApp.Documents.Open(FileName:=Top$+i+".dat")
    Dim WksRange As Object
	Set WksRange = Wks.Columns(Col1:=1, Col2:=2)
	WksRange.Clear
	Dim WksRange2 As Object
	Set WksRange2 = Wks.Columns(Col1:=3)
	WksRange2.Cut
	Dim WksRange3 As Object
	Set WksRange3 = Wks.Columns(Col1:=2)
	WksRange3.Paste
	Dim WksRange4 As Object
	Set WksRange4 = Wks.Columns(Col1:=4)
	WksRange4.Cut
	Dim WksRange5 As Object
	Set WksRange5 = Wks.Columns(Col1:=1)
	WksRange5.Paste
	nrows = WksRange5.Count
	Dim WksRange6 As Object
	Set WksRange6 = Wks.Rows(Row1:=1)
	WksRange6.Insert
	Dim WksRange7 As Object
	Set WksRange7 = Wks.Cells("A1")
	WksRange7.Value = nrows
	Wks.SaveAs(FileName:=Top$+i+".bln")

'Rearranges DAT and saves as BLN for Bottom
	Dim Wks1 As Object
	Set Wks1 = SurferApp.Documents.Open(FileName:=Bottom$+i+".dat")
    Dim WksRange8 As Object
	Set WksRange8 = Wks1.Columns(Col1:=1, Col2:=2)
	WksRange8.Clear
	Dim WksRange9 As Object
	Set WksRange9 = Wks1.Columns(Col1:=3)
	WksRange9.Cut
	Dim WksRange10 As Object
	Set WksRange10 = Wks1.Columns(Col1:=2)
	WksRange10.Paste
	Dim WksRange11 As Object
	Set WksRange11 = Wks1.Columns(Col1:=4)
	WksRange11.Cut
	Dim WksRange12 As Object
	Set WksRange12 = Wks1.Columns(Col1:=1)
	WksRange12.Paste
	nrows1 = WksRange12.Count
	Dim WksRange13 As Object
	Set WksRange13 = Wks1.Rows(Row1:=1)
	WksRange13.Insert
	Dim WksRange14 As Object
	Set WksRange14 = Wks1.Cells("A1")
	WksRange14.Value = nrows1
  	Wks1.SaveAs(FileName:=Bottom$+i+".bln")
  	Wks1.Close(SaveChanges:=srfSaveChangesNo)

'Combines the BLN files into one
	Wks.Merge(FileName:=Bottom$+i+".bln", Row:=nrows+2, Col:=1)
  	Wks.SaveAs(FileName:=Top$+i+"Combined.bln")
  	Wks.Close(SaveChanges:=srfSaveChangesNo)

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

Next i

Plot.Shapes.SelectAll
Set NewMapFrame = Plot.Selection.OverlayMaps


End Sub

Updated February 14, 2017