一、创建
和
打印
等高线
图
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
坐标轴就下面几个属性,对照图就可明白了:
基本就这些,变异函数就不录入这个程序了。
原文链接:https://www.f2er.com/vb/258930.html