抽空写了一个。
发现删除surfer 8,安装surfer11,程序仍能运行。
'2013.05.19 '白话魔法师 Option Explicit Private Sub Command1_Click() Dim srf As New Surfer.Application Dim poltDoc As Surfer.IPlotDocument Dim mapFrame As Surfer.IMapFrame Dim mapContour As Surfer.IContourMap Dim ColorScale As Surfer.IDiscreteColorScale Dim mapBase As Surfer.IBaseMap Dim shpText As Surfer.IText Dim Axis As Surfer.IAxis '是否显示surfer界面 srf.Visible = False '增加绘图文档 Set poltDoc = srf.Documents.Add(srfDocPlot) '网格化 srf.GridData DataFile:=App.Path & "\1.xls",xCol:=1,yCol:=2,zCol:=3,NumCols:=200,NumRows:=200,xMin:=106.6333,xMax:=108.5333,_ yMin:=30.3333,yMax:=32.35,showreport:=False,outgrid:=App.Path & "\1.grd" DoEvents '白化 srf.GridBlank ingrid:=App.Path & "\1.grd",blankfile:=App.Path & "\CityBlank.bln",outgrid:=App.Path & "\out.grd" '等值线 Set mapFrame = poltDoc.Shapes.AddContourMap(App.Path & "\out.grd") '轴线 For Each Axis In mapFrame.Axes Axis.Visible = False Next '等值线属性设置 Set mapContour = mapFrame.Overlays(1) With mapContour .FillContours = True .BlankLine.Style = "solid" ' .BlankLine.Width = 0.015 .SmoothContours = srfConSmoothHigh .Levels.LoadFile App.Path & "\R24level.lvl" End With '加载底图 Set mapFrame = poltDoc.Shapes.AddBaseMap(App.Path & "\MidCountry.bna") Set mapBase = mapFrame.Overlays(1) mapBase.Line.Width = 0.01 ' Set mapFrame = poltDoc.Shapes.AddBaseMap(App.Path & "\CityBlank.bln") ' Set mapBase = mapFrame.Overlays(1) ' mapBase.Line.Width = 0.015 '叠放 poltDoc.Shapes.SelectAll poltDoc.Selection.OverlayMaps mapContour.ShowColorScale = True Set ColorScale = mapContour.ColorScale With ColorScale .LabelFont.Size = 22 .Top = 4 .Left = 6.2 .Height = 1.2 .Width = 0.5 End With '加载文字--标题 Set shpText = poltDoc.Shapes.AddText(1,1,"不明物质分布图") With shpText .Top = 2.2 .Left = 4.3 .Font.VAlign = srfTAVCenter .Font.HAlign = srfTACenter .Font.Bold = True .Font.Size = 12 End With '加载文字--图例 Set shpText = poltDoc.Shapes.AddText(1,"图例") With shpText .Top = 4.2 .Left = 6.4 .Font.VAlign = srfTAVCenter .Font.HAlign = srfTACenter .Font.Bold = True End With '输出图片,加载到程序中 poltDoc.Export App.Path & "\p1.emf" Image1.Picture = LoadPicture(App.Path & "\p1.emf") srf.Documents.CloseAll srfSaveChangesNo srf.Quit End Sub
-----------------------
右边是一些设置,是一个完善和自制化。
比如:
2、选择是否显示边界、站点名(就是加载Post图,程序中没有编出)
3、还可以设置一些颜色条的自制。
等等,这个是根据个人需要自已来弄。
感觉,全英文的的确费力。还好Scripter的较简单,加上微软的翻译。
推荐一下,还是用必应的翻译,因为这个对编程的翻译比金山和有道更强一些(其它类的还是用金山和有道吧)
原文链接:https://www.f2er.com/vb/258902.html