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:
- Copy the script below, or download the attached BAS file: SliceFormations.bas
- In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Surfer 14\Scripter.
- Double click on Scripter.exe to launch Scripter.
- Press Ctrl+A to select all of the existing lines then press Delete.
- 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.
- 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.
- 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:
- Right click over one of the Base layers in the Contents window and click Edit Group.
- Select both polylines in the base layer and click Features | Edit Polylines | Connect Polylines.
- Click Features | Change Type | Change Type | Polyline to Polygon.
- In the Properties window, click the Fill tab and set the fill properties to whatever you want.
- Right click over the Base layer in the Contents window and click Stop Editing Group.
- 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
0 Comments