- 积分
- 18
- 贡献
-
- 精华
- 在线时间
- 小时
- 注册时间
- 2011-11-22
- 最后登录
- 1970-1-1
|
登录后查看更多精彩内容~
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
Dim surfapp As Object 'Application
Set surfapp = CreateObject("surfer.application")
surfapp.Visible = False
surfapp.GridData DataFile:=App.Path + "\station.txt", xCol:=1, yCol:=2, zCol:=3, Algorithm:=srfKriging, ShowReport:=False, outgrid:=App.Path + "\station.grd", xMin:=114.9, xMax:=115.6167, yMin:=22.7, yMax:=23.2333
Dim plot As Surfer.IDocument
Dim contourmapfame As Surfer.IMapFrame
Dim ContourMap As Surfer.IContourMap
surfapp.GridBlank Ingrid:=App.Path + "\station.grd", blankfile:=App.Path + "\arcgis.bln", outgrid:=App.Path + "\station.grd", outfmt:=srfGridFmtS7 '白化
Set plot = surfapp.Documents.Add(1) '生成一个空白的绘图页
Set contourmapframe = plot.Shapes.AddContourMap(App.Path & "\station.grd") '生成一个等值线图
Set ContourMap = contourmapframe.Overlays(1) '----- 将等值线图形属性指定给变量ContourMap
ContourMap.Levels.LoadFile (App.Path + "\sebiao.lvl") '--- 加载等值线填充色彩分级文件
ContourMap.SmoothContours = 4 '--等值线平滑
ContourMap.FillContours = True '--- 填充
ContourMap.ShowColorScale = True 'False '---是否显示色标
Set basemap = plot.Shapes.AddBaseMap(importfilename:=App.Path + "\arcgis.bln")
plot.Shapes.SelectAll
Dim sel As Object
Set sel = plot.Selection
sel.OverlayMaps
plot.Shapes.SelectAll ' ---将上述所有图层进行合并
plot.Export filename:=App.Path & "\station.gif", Options:="defaults=1,Width=600,Height=400,ColorDepth=24"
plot.Close savechanges:=srfSaveChangesNo
surfapp.Quit '释放surfer模块
Picture2.Picture = LoadPicture(App.Path & "\station.gif")
|
|