Surfer-Scripter-Automation/plot_process.BAS at main · Reybor/Surfer-Scripter-Automation · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
'what to plot, contour value max min, contour png dpi
Sub Main()
    ' Create Surfer application object
    Dim SurferApp As Object
    Set SurferApp = CreateObject("Surfer.Application")
    SurferApp.Visible = True
    Debug.Clear

    ' Define input and output folders
    Dim dataFolder As String, outFolder As String
    dataFolder = "D:\Users"
    outFolder = dataFolder & "png\"

    ' Ensure output folder exists
    If Dir(outFolder, vbDirectory) = "" Then
        MkDir outFolder
    End If

    ' Create a new plot document
    Dim Plot As Object
    Set Plot = SurferApp.Documents.Add

    ' Get the first .grd file in the folder
    Dim fileName As String
    fileName = Dir(dataFolder & "*.grd")

    ' Declare objects for map and layers
    Dim MapFrame As Object
    Dim ContourLayer As Object
    Dim Axes As Object
    Dim BottomAxis As Object, LeftAxis As Object, RightAxis As Object, TopAxis As Object

    ' Variables for file name processing
    Dim fullPath As String
    Dim baseName As String
    Dim posDot As Long

    ' Optional: offset for placing maps vertically in the plot
    Dim yOffset As Double
    yOffset = 0

    ' Loop through all .grd files in the folder
    Do While fileName <> ""
        fullPath = dataFolder & fileName

        ' Add contour map for the current .grd file
        Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=fullPath)

        ' Position map in the plot (optional, for visual separation)
        MapFrame.Top = yOffset
        yOffset = yOffset + MapFrame.Height + 0.5

        ' Extract base name (without extension) and set as MapFrame name
        baseName = fileName
        posDot = InStrRev(baseName, ".")
        If posDot > 0 Then baseName = Left(baseName, posDot - 1)
        MapFrame.Name = baseName

        ' Set scaling ratio (map units per page unit)
        MapFrame.xMapPerPU = 300
        MapFrame.yMapPerPU = 300

        ' Get Axes collection from the MapFrame
        Set Axes = MapFrame.Axes

        ' Assign individual axes to variables
        Set BottomAxis = Axes("Bottom axis")
        Set LeftAxis = Axes("Left axis")
        Set RightAxis = Axes("Right axis")
        Set TopAxis = Axes("Top axis")

        ' Hide the top axis
        TopAxis.Visible = False

        ' Configure contour layer appearance
        Set ContourLayer = MapFrame.Overlays(1)
        ContourLayer.LevelMethod = SrfConLevelMethodSimple
        ContourLayer.FillContours = True
        ContourLayer.FillForegroundColorMap.LoadPreset "Rainbow"
        ContourLayer.FillForegroundColorMap.SetDataLimits DataMin:=0.5, DataMax:=4

        ' Ensure only the current MapFrame is selected before export
        Call DeselectAllTopLevel(Plot)
        MapFrame.Selected = True

        ' Export the selected MapFrame as PNG with 450 DPI
        ' Syntax: object.Export(FileName, SelectionOnly, Options)
        Plot.Export FileName:=outFolder & baseName & ".png", _
                    SelectionOnly:=True, _
                    Options:="HDPI=450, VDPI=450, KeepAspect=1"

        ' Move to the next .grd file
        fileName = Dir
    Loop

    MsgBox "Batch plotting and individual exports completed!"
End Sub

' Helper procedure: deselect all top-level shapes in the plot
Private Sub DeselectAllTopLevel(ByVal Plot As Object)
    On Error Resume Next
    Dim i As Long
    For i = 1 To Plot.Shapes.Count
        Plot.Shapes.Item(i).Selected = False
    Next i
    On Error GoTo 0
End Sub