抽空写了一个。
发现删除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, 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
-----------------------
右边是一些设置,是一个完善和自制化。
比如:
1、设置文本内容,这样就可以自定义文本了。
2、选择是否显示边界、站点名(就是加载Post图,程序中没有编出)
3、还可以设置一些颜色条的自制。
等等,这个是根据个人需要自已来弄。
感觉,全英文的的确费力。还好Scripter的较简单,加上微软的翻译。
推荐一下,还是用必应的翻译,因为这个对编程的翻译比金山和有道更强一些(其它类的还是用金山和有道吧)