Follow

How can I slice multiple maps to create a profile of non-adjacent layers (like a coal seam) in 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: SliceNonAdjacentFormations.BAS.
  2. In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Surfer 16.
  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
	Wait(3)
	Debug.Clear

'===============================
'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)
	WksRange.Clear

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

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

	'Save the file
	Wks.SaveAs(FileName:=Top$+i+".dat")

	'======================================
	'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)
	WksRange7.Cut
	Set WksRange8 = Wks1.Columns(Col1:=2)
	WksRange8.Paste

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

	'Save the file as a BLN
  	Wks1.SaveAs(FileName:=Bottom$+i+".dat")

	'======================================
	'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)
	WksRange12.Copy

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

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

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

	'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
	WksRange14.Insert
	Set WksRange16 = Wks.Cells("A1")
	WksRange16.Value = nrows

	'Save the file and close the worksheet windows
  	Wks.SaveAs(FileName:=Top$+i+"Combined.bln")
  	Wks.Close(SaveChanges:=srfSaveChangesNo)
  	Wks1.Close(SaveChanges:=srfSaveChangesNo)

	'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
Plot.Shapes.SelectAll
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
r=0
g=0
b=0
Interval=Int(255/NumForm)
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)
	r=r+((j-1)*Interval)
	g=g+((j-1)*Interval)
	b=b+((j-1)*Interval)
Next j

End Sub

 

Updated November 12, 2018

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.