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 mapEnd Sub

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

代码如下：

Option ExplicitPrivate 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, Algorithm:=srfKriging, 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.QuitEnd 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 documentsEnd Sub

改成VB：

Option ExplicitDim srf  As New Surfer.ApplicationDim Docs As Surfer.IDocumentsPrivate 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.CloseAllEnd Sub

三、修改轴

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

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

         

上面改为VB：

Option ExplicitDim srf      As New Surfer.ApplicationDim Axis     As Surfer.IAxisDim mapFrame As Surfer.IMapFrameDim plotDoc  As Surfer.IPlotDocumentPrivate 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 = oldupdateEnd SubPrivate 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

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

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