|
surfer我不常用,所以这段代码比较简陋,但批量出图的基本功能还是有的。代码见附件ContourMap_aya.bas,具体如下:
Sub aya_contourmap Debug.Clear '基本知识:Dim开头的语句为定义语句,Set语句为建立语句,这两种语句大概明白就可以了 ' ' '打开surfer软件,并显示 Dim SurferApp As Object Set SurferApp = CreateObject("Surfer.Application") SurferApp.Visible = True 'false则为不显示 '新建绘图文档 Dim Plot As Object Set Plot = SurferApp.Documents.Add '定义循环数i,并将其转化为字符,以便下文使用 Dim i As Integer Dim Name() As Variant Name()=Array("gc1","gc2","gc3") '数据文件名 For i = 1 To 2 '设置循环 '生成网格,数据文件与白化轮廓文件时必须的 DataFile = SurferApp.Path + "\data\1\"+Name(i-1)+".xyz" '数据文件 InGrid = SurferApp.Path + "\data\1\"+Name(i-1)+".grd" '生成的网格文件 BlankFile = SurferApp.Path + "\data\20bj.bln" '白化轮廓文件 BlankedGrid = SurferApp.Path + "\data\1\"+"blanked"+Name(i-1)+".grd" '白化后的网格文件 '用最小曲率法划分网格,并显示在surfer里(需要修改的是xsize与ysize) SurferApp.GridData3 (DataFile:=DataFile, Algorithm:= srfMinCurvature, _ xSize:=100, ySize:=100, ShowReport:=False, OutGrid:=InGrid) '生成白化后的网格文件 SurferApp.GridBlank (InGrid:=InGrid, BlankFile:=BlankFile, Outgrid:=BlankedGrid) '利用白化后的网格绘制等值线图 Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=BlankedGrid) 'MapFrame.SetLimits (xMin:=0.5, xMax:=4.5, yMin:=0.5, yMax:=3.5) '定义图框上的四个坐标轴,并隐藏显示 Dim Axes As Object Set Axes = MapFrame.Axes Set BottomAxis = Axes("Bottom axis") Set LeftAxis = Axes("Left axis") Set RightAxis = Axes("Right axis") Set TopAxis = Axes("Top axis") LeftAxis.Visible=False '隐藏左坐标轴 BottomAxis.Visible=False RightAxis.Visible=False TopAxis.Visible=False '设定等值线图的相关参数 Dim ContourLayer As Object Set ContourLayer = MapFrame.Overlays(1) ContourLayer.Name = "contourmap_"+Name(i-1) '重命名 ContourLayer.SmoothContours = srfConSmoothHigh ContourLayer.FillContours = True '显示colormap 'ContourLayer.FillForegroundColorMap.LoadPreset("Rainbow") ContourLayer.FillForegroundColorMap.SetDataLimits (DataMin:=0, DataMax:=25) 'colormap中的最大最小值 '自定义配色方案 Dim Positions(4) As Double Positions(0)=0.0 Positions(1)=0.25 Positions(2)=0.5 Positions(3)=0.75 Positions(4)=1.0 Dim Colors(4) As Long Colors(0)=RGB(0,0,255) Colors(1)=RGB(0,255,255) Colors(2)=RGB(0,255,0) Colors(3)=RGB(255,255,0) Colors(4)=RGB(255,0,0) ContourLayer.FillForegroundColorMap.SetNodes(Positions:=Positions, Colors:=Colors) 'ContourLayer.FillForegroundColorMap.Reverse 'Reverses the colormap '等值线图level层级的相关设置 ContourLayer.LevelMethod = SrfConLevelMethodSimple ContourLayer.SetSimpleLevels(Min:=0, Max:=25, Interval:=0.5) ContourLayer.LevelMajorInterval = 1 ContourLayer.MajorLine.ForeColorRGBA.Opacity = 0 ContourLayer.ShowMajorLabels = False ContourLayer.MinorLine.ForeColorRGBA.Opacity = 0 ContourLayer.ShowMinorLabels = False '等值线图输出dxf 'ContourLayer.ExportContours(FileName:=SurferApp.Path+"\data\Contours.dxf", Format:=srfConFormatDXF) '等值线图的位置与大小 MapFrame.Top=3 '图框的y方向 MapFrame.Left=-25 '图框的x方向 MapFrame.xLength = 60 '图框的x方向大小 MapFrame.yLength = 25 '图框的y方向大小 '等值线图输出为jpg 'Plot.Export(FileName:= SurferApp.Path+"\data\demogrid.jpg", SelectionOnly:=False ,Options:="Width=6560, Height=2920") '打印pdf 'Plot.PrintOut MapFrame.Visible=False Next End Sub
祝各位生活愉快
Archiver|手机版|科学网 ( 京ICP备07017567号-12 )
GMT+8, 2023-3-22 20:55
Powered by ScienceNet.cn
Copyright © 2007- 中国科学报社