surfer 8 scripter 学习笔记7软件自带例子转为VB程序

一、创建 和 打印 等高线 图

此 示例将 自动 创建 等高线 图 直观显示 地下水 水平的 变化 的 过程。

该 脚本 提示 用户 输入 一个 数据 文件 、 从 文件 创建 网格 、 创建 等高线 图 、 打印 地图 ，然后 保存 地图 [. SRF]。

Sub Main()
    'Declare object and string variables used in the script
    Dim SurferApp,Plot,ContourMapFrame,ContourMap As Object
    Dim InFile,GridFile,BaseName As String

    'Create the Surfer Application object and assign it to the "SurferApp" variable
    Set SurferApp = CreateObject("Surfer.Application")
    SurferApp.Visible = True 'Make Surfer visible
    'Prompt the user for the name of the data file to process.
    InFile = GetFilePath("","DAT;TXT;CSV;XLS",CurDir(),"Select data file",0)

    If InFile = "" Then End 'Can't continue: no file was selected
    'Get file name without the extension (for example,"week5.txt" becomes "week5")
    BaseName = InFile
    ExtStart = InStrRev(InFile,".")

    If ExtStart > 1 Then BaseName = Left(InFile,ExtStart - 1)
    'Create a grid from the specified data file using the Kriging algorithm
    GridFile = BaseName + ".grd"
    SurferApp.GridData DataFile:=InFile,Algorithm:=srfKriging,DupMethod:=srfDupNone,ShowReport:=False,OutGrid:=GridFile
    'Create a plot document in Surfer and assign it to the variable named "Plot"
    Set Plot = SurferApp.Documents.Add(srfDocPlot)
    'Create a contour map. Assign the map frame to the "ContourMapFrame" variable
    Set ContourMapFrame = Plot.Shapes.AddContourMap(GridFile)
    'Assign the contour map properties to the variable named "ContourMap"
    Set ContourMap = ContourMapFrame.Overlays(1)
    ContourMap.FillContours = True 'Fill the contour map levels
    Plot.PrintOut 'Print the page on the default printer
    Plot.SaveAs (BaseName + ".srf") 'Save the map
End Sub

在VB中新建一窗体，引用surfer 8 type library，添加一command和commondialog

代码如下：

Option Explicit

Private Sub Command1_Click()
    Dim srf        As New Surfer.Application
    Dim plotDoc    As Surfer.IPlotDocument
    Dim mapFrame   As Surfer.IMapFrame
    Dim mapContour As Surfer.IContourMap
    Dim inFile     As String
    Dim outFile    As String
    Dim intPos     As Integer
    Dim baseName   As String

    '输入文件及输出文件路径
    CommonDialog1.Filter = "DAT文件|*.dat|TXT文件|*.txt|CSV文件|*.csv|XLS文件|*.xls"
    CommonDialog1.ShowOpen
    inFile = CommonDialog1.FileName

    If inFile = "" Then Exit Sub
    intPos = InStrRev(inFile,".")

    If intPos > 1 Then baseName = Left$(inFile,intPos - 1)
    outFile = baseName & ".grd"
    
    
    
    srf.Visible = True '显示界面
    srf.ScreenUpdating = False '界面不刷新，这样提高效率
    
    
    '网格化输入文件
    srf.GridData DataFile:=inFile,showreport:=False,outgrid:=outFile,dupmethod:=srfDupNone
    Set plotDoc = srf.Documents.Add(srfDocPlot) '加入绘图文档
    Set mapFrame = plotDoc.Shapes.AddContourMap(outFile) '在绘图文档上添加等值线。注意是mapframe类型，不是contourmap类型，因为含坐标轴等
    Set mapContour = mapFrame.Overlays(1)       '这个才真正的contourmap类型
    mapContour.FillContours = True              '显示着色
    plotDoc.SaveAs baseName & "1.srf"           '另存为
    '    plotDoc.PrintOut   '用默认打印机打印。参数用默认
    srf.ScreenUpdating = True '这才刷新显示图形
    
    
    srf.Documents.CloseAll srfSaveChangesNo
    srf.Quit
End Sub

二、打开、保存和关闭文档

Document集合提供对Surfer文件命令的访问。
使用Documents 对象"打开"方法打开现有的绘图、工作表或网格文件。
使用Add方法创建一个空白的绘图或工作表。
SaveAll方法将保存所有打开的文档，和CloseAll方法将关闭所有打开的文档。
若要保存或关闭单个文档，使用Document对象的Save,SaveAs，及Close方法。

Sub Main()

    Set srf = CreateObject("Surfer.Application")
    srf.Visible = True
    srf.Documents.Add srfDocPlot ' Create a blank plot
    srf.Documents.Add srfDocWks ' Create a blank worksheet
    FileName$ = GetFilePath(,"SRF")   ' Open an existing plot

    If FileName$ <> "" Then
        srf.Documents.Open FileName$
    End If
    FileName$ = GetFilePath(,"XLS")    ' Open the sheet named "Sheet1" from an Excel file

    If FileName$ <> "" Then
        srf.Documents.Open FileName$,"Sheet=Sheet1"
    End If
    srf.ActiveDocument.Close ' Close the active document

    If Not srf.ActiveDocument.Saved Then ' Save the active document using its current name
        srf.ActiveDocument.Save
    End If
    srf.Documents("Plot1").SaveAs "MyDocument" ' Save the document whose window caption is "Plot1"
    srf.Documents.CloseAll ' Close all documents
End Sub

改成VB：

Option Explicit
Dim srf  As New Surfer.Application
Dim Docs As Surfer.IDocuments

Private Sub Command1_Click()
    srf.Visible = True
    Set Docs = srf.Documents
    srf.Windows.Arrange srfCascade

    Docs.Add srfDocPlot
    Docs.Add srfDocWks
    
    
    '打开srf文件
    CommonDialog1.Filter = "SRF文件|*.srf"
    CommonDialog1.ShowOpen

    If CommonDialog1.FileName <> "" Then

        Docs.Open CommonDialog1.FileName
    End If
    
    
    '打开xls文件
    CommonDialog1.Filter = "XLS文件|*.xls"
    CommonDialog1.ShowOpen

    If CommonDialog1.FileName <> "" Then

        Docs.Open CommonDialog1.FileName,"sheet=sheet1"
    End If
    srf.ActiveDocument.Close '关闭当前文档，即最后激活的excel

    If Not srf.ActiveDocument.Saved Then  '下面一个被激活窗体srf，是否改变
        srf.ActiveDocument.Save
    End If

    Docs("Plot1").SaveAs "mydocument" '把开始默认的文档存盘
    Docs.CloseAll
End Sub

三、修改轴

坐标轴可以用Axis对象进行修改。

可以用Axes集合来访问 Axis对象，也可以通过mapFrame对象来访问它（前面说过这个对象包含图形本身和坐标轴等）

上面改为VB：

Option Explicit
Dim srf      As New Surfer.Application
Dim Axis     As Surfer.IAxis
Dim mapFrame As Surfer.IMapFrame
Dim plotDoc  As Surfer.IPlotDocument

Private Sub Command1_Click() '修改坐标轴
    Dim oldupdate As Boolean

    oldupdate = mapFrame.Application.ScreenUpdating
    mapFrame.Application.ScreenUpdating = False '关闭刷新

    For Each Axis In mapFrame.Axes '有几种，左轴，右轴，上轴，下轴

        If Axis.AxisType = srfATLeft Or Axis.AxisType = srfATBottom Then '左轴或下轴时

            With Axis
                .MajorTickType = srfTickCross
                .MinorTickType = srfTickIn
                .MinorTickLength = 0.1
                .MinorTicksPerMajor = 9
                .ShowMajorGridLines = True
                .AxisLine.Width = 0.03
            End With

        End If
    Next

    mapFrame.Application.ScreenUpdating = oldupdate
End Sub

Private Sub Form_Load() '启动surfer,加载等值线
    srf.Visible = True
    Set plotDoc = srf.Documents.Add(srfDocPlot)
    Set mapFrame = plotDoc.Shapes.AddContourMap("C:\Program Files\Golden Software\Surfer8\Samples\demogrid.grd")
End Sub

坐标轴就下面几个属性，对照图就可明白了：

基本就这些，变异函数就不录入这个程序了。