请选择 进入手机版 | 继续访问电脑版
爱气象,爱气象家园! 

气象家园

 找回密码
 立即注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

搜索
查看: 20908|回复: 35

[源程序] vb+surfer绘制自动站监测图形

[复制链接]

新浪微博达人勋

发表于 2011-8-31 08:42:59 | 显示全部楼层 |阅读模式

登录后查看更多精彩内容~

您需要 登录 才可以下载或查看,没有帐号?立即注册 新浪微博登陆

x
Private Sub drawapic(strinfile As String)
Dim objSurfer As Application
Dim objPlot As Surfer.IDocument
Dim objMapFrame As Surfer.IMapFrame
Dim temp As Boolean
'Dim strinfile As String
Dim strGridFile As String
strGridFile = Left(strinfile, Val(InStrRev(strinfile, ".")) - 1) + ".grd"   '把扩展名改为.grd
Set objSurfer = CreateObject("Surfer.Application") '创建surfer对象
Set objPlot = objSurfer.Documents.Add(1)
With objSurfer
.GridData DataFile:=App.Path + "\" + strinfile, Algorithm:=srfKriging, dupmethod:=2, showreport:=False, SearchEnable:=True, OutGrid:=App.Path + "\" + strGridFile, xMin:=119.1, xMax:=121.2, yMin:=28.3, yMax:=29.8, NumCols:=301, NumRows:=301
.Visible = False
End With
'创建对象(CreateObject)是Vb提供的一个方法,它表示CreateObject方法在系统注册表里查找"Surfer.APPhcafion"项并自动激活Surfer服务
'objSurfer.Visible = False   'surfer软件本身不在前台显示
'temp = objSurfer.GridData(xCol:=1, yCol:=2, zCol:=3, DataFile:=strinfile, dupmethod:=srfDupNone, xMin:=119.1, xMax:=121.2, yMin:=28.3, yMax:=29.8, NumCols:=301, NumRows:=301, Algorithm:=srfKriging, OutGrid:=strGridFile, OutFmt:=srfGridFmtAscii, showreport:=False) ' OutFmt:=srfGridFmtAscii,
'用Kriging法将资料内插到网格点上,并确定网格点的最大(小)经纬度,等值线图边界大小。outgrid为数据插值之后输出的文件名。
Dim ContourMap As Surfer.IContourMap
Dim levels As ILevels
    temp = objSurfer.GridBlank(Ingrid:=App.Path + "\" + strGridFile, blankfile:=App.Path + "\bln\jinhout.bln", OutGrid:=App.Path + "\out" + ".grd")
    '用闭合区域底图bz1.bln文件去掉边界外的插值后的数据,为绘制区域等值线做准备。
    Set objMapFrame = objPlot.Shapes.AddContourMap(App.Path + "\out" + ".grd")  '绘制等值线图,并添加到文档
'生成一个等值线图,并指定其文件名为ContourMapFrame。
   Set ContourMap = objMapFrame.Overlays(1)
  
  ContourMap.SmoothContours = 4 '平滑等值线
  ContourMap.FillContours = True '设置等值线填充
  
Set levels = ContourMap.levels
levels.LoadFile (App.Path + "\aa.lvl")
objMapFrame.Axes(1).Visible = False
objMapFrame.Axes(3).Visible = False
objMapFrame.Axes(2).Visible = False
objMapFrame.Axes(4).Visible = False
ContourMap.ShowColorScale = True   '显示色标
ContourMap.ColorScale.FrameLine.Width = 0#
ContourMap.ColorScale.Left = ContourMap.Width + ContourMap.Left - 0.9
ContourMap.ColorScale.Width = 0.3
ContourMap.ColorScale.Height = 2
ContourMap.ColorScale.Top = ContourMap.Top - (ContourMap.Height - ContourMap.ColorScale.Height) / 2
ContourMap.ColorScale.LabelFont.Size = 8
'等值线数值标注的字体和大小
ContourMap.LabelFont.Size = 5

'加载地名标注
Dim Shapes As Object
Dim MapFrame As IMapFrame
Dim PostMap As IPostMap
Set Shapes = objPlot.Shapes
Set MapFrame = Shapes.AddPostMap(DataFileName:=App.Path + "\站点信息.ini", xCol:=2, yCol:=3, LabCol:=4, SymCol:=4)
Set PostMap = MapFrame.Overlays(1)
'对张贴图的属性进行设置
  PostMap.Symbol.Size = 0.02
PostMap.Symbol.Index = 12
'设置站点符号的大小和形状
PostMap.LabelFont.Face = "宋体"
PostMap.LabelFont.Size = 4
'设置站点名称的字体和大小
'显示等值线色标,并给a、b、c、d赋值。
'Dim ContourMap As Surfer.IContourMap
Dim mybasemap1 As Surfer.IMapFrame
   Set mybasemap1 = objPlot.Shapes.AddBaseMap(ImportFileName:=App.Path + "\bln\jinh.bln") '添加底图
Dim mybasemap2 As Surfer.IMapFrame
   Set mybasemap2 = objPlot.Shapes.AddBaseMap(ImportFileName:=App.Path + "\bln\jinhout.bln") '添加底图
  mybasemap2.BackgroundLine.Width = 0.2
''基面图属性
'For Each Axis In myBasemap1.Axes
'With Axis
'.Visible = False
'End With
'Next

   objPlot.Shapes.SelectAll
   
   '合并图形
   objPlot.Selection.OverlayMaps

'坐标轴相关属性
objPlot.Export FileName:=App.Path + "\" + Left(strinfile, Val(InStrRev(strinfile, ".")) - 1) + ".bmp", Options:="width=3200,height=2000" '输出bmp
'Picture1.Picture = LoadPicture(Left(strinfile, Val(InStrRev(strinfile, ".")) - 1) + ".bmp")         '显示bmp
'Next p
   objPlot.Close savechanges:=srfSaveChangesNo
   objSurfer.Quit
Set objSurfer = Nothing
End Sub

评分

参与人数 3金钱 +21 贡献 +9 收起 理由
传说中的谁 + 8 + 2 很给力
mofangbao + 5 + 3
topmad + 8 + 4 赞一个!

查看全部评分

密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2011-8-31 08:44:42 | 显示全部楼层
初学vb,对环境下surfer的精细化设置还不是很清楚,如缺测值、图层叠加顺序如何设置等,请高手指点
密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2011-8-31 08:45:45 | 显示全部楼层

D:\my&vb\vbsurfer\110617zcd查询及绘图\resultdata.bmp

点评

上传图片需要点击 图片-批量上传,上传后点击图片即可插入  发表于 2011-8-31 09:30
密码修改失败请联系微信:mofangbao

新浪微博达人勋

0
早起挑战累计收入
发表于 2011-8-31 09:34:02 | 显示全部楼层
借用射月楼主的一句话,最好的帮助文件是软件的使用手册
密码修改失败请联系微信:mofangbao

新浪微博达人勋

发表于 2011-8-31 10:44:06 | 显示全部楼层
要是能把出来的图也一起拿出来就好了
密码修改失败请联系微信:mofangbao

新浪微博达人勋

发表于 2011-8-31 12:23:52 | 显示全部楼层
我想请教一下,VB调用surfer时需要添加引用吗?另外就是有没有将BMP转成GIF的插件,因为位图太占存储空间了?谢谢楼主无私的分享!
密码修改失败请联系微信:mofangbao

新浪微博达人勋

发表于 2011-9-1 10:21:56 | 显示全部楼层
很好,支持一下
密码修改失败请联系微信:mofangbao

新浪微博达人勋

发表于 2011-9-6 21:38:15 | 显示全部楼层
很好,支持一下
密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2011-9-8 10:22:53 | 显示全部楼层
做了一个比较简单的中尺度站评估程序,能自动生成评估图形及描述文字d:\zcdpg.jpg
密码修改失败请联系微信:mofangbao

新浪微博达人勋

发表于 2011-9-8 16:32:11 | 显示全部楼层
努力学习中,不知道能成不
密码修改失败请联系微信:mofangbao
您需要登录后才可以回帖 登录 | 立即注册 新浪微博登陆

本版积分规则

Copyright ©2011-2014 bbs.06climate.com All Rights Reserved.  Powered by Discuz! (京ICP-10201084)

本站信息均由会员发表,不代表气象家园立场,禁止在本站发表与国家法律相抵触言论

快速回复 返回顶部 返回列表