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

气象家园

 找回密码
 立即注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

搜索
查看: 8897|回复: 22

[vbscript] Surfer13自带脚本库中文标注

[复制链接]

新浪微博达人勋

发表于 2017-4-6 13:01:50 | 显示全部楼层 |阅读模式

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

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

x
打算陆陆续续将Surfer13自带脚本库翻译完毕,请问在论坛以“代码”格式发帖,为什么不能正常显示?
密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2017-4-6 13:03:36 | 显示全部楼层
本帖最后由 大老鹰 于 2017-4-7 10:00 编辑

更新四个脚本。

编辑基底图组.BaseMap_EditGroup.bas

3.02 KB, 下载次数: 9, 下载积分: 金钱 -5

基底图.BaseMap.bas

3.16 KB, 下载次数: 8, 下载积分: 金钱 -5

设置边轴.Axes.bas

3.08 KB, 下载次数: 9, 下载积分: 金钱 -5

添加图层.AddLayer.BAS

1.39 KB, 下载次数: 8, 下载积分: 金钱 -5

评分

参与人数 1金钱 +30 贡献 +8 收起 理由
chengxf + 30 + 8 很给力!

查看全部评分

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

新浪微博达人勋

 楼主| 发表于 2017-4-7 09:18:47 | 显示全部楼层
本帖最后由 大老鹰 于 2017-4-7 10:31 编辑

  1. Sub Main
  2. '源代码来自Surfer13自带样本库,老鹰进行了中文标注。边译边学,毗漏难免,欢迎交流指正。
  3. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
  4.         Dim SurferApp As Object
  5.         Set SurferApp = CreateObject("Surfer.Application")
  6.         SurferApp.Visible = True

  7. '声明场景为对象。新建场景文件。
  8.         Dim Plot As Object
  9.         Set Plot = SurferApp.Documents.Add

  10. '添加分类散点图为图形,该文件路径:SurferApp.Path+"\Samples\demogrid.dat"。X、Y、Z列数据分别来自1、2、3栏,标注来自第3栏。
  11.         Set MapFrame = Plot.Shapes.AddClassedPostMap(DataFileName:=SurferApp.Path+"\Samples\demogrid.dat", xCol:= 1, yCol:=2, zCol:=3, LabCol:=3)

  12. '声明分类散点图为对象。属于第1图层。
  13.         Dim ClassedPostLayer As Object
  14.         Set ClassedPostLayer = MapFrame.Overlays(1)

  15. '分为4类。
  16.     ClassedPostLayer.NumClasses = 4

  17. <font color="Red">'分类方法:用户自定义。此分类不可用,查了14版手册,将其改成了数值“3”,同样没有改变。
  18.         ClassedPostLayer.BinningMethod =srfPostUser

  19. '设置8个双精度分类锚点。
  20.         Dim binlimits(1 To 8) As Double
  21.         binlimits(1) = 25 : binlimits(2) = 50
  22.         binlimits(3) = 50 : binlimits(4) = 75
  23.         binlimits(5) = 75 : binlimits(6) = 100
  24.         binlimits(7) = 100 : binlimits(8) = 110

  25.         ClassedPostLayer.SetBinLimits(Limits:=binlimits)</font>

  26. '设置分类符属性。第1类,尺码0.15,10号符,(Green)绿色。
  27.         ClassedPostLayer.BinSymbol(Index:=1).Size = 0.15
  28.         ClassedPostLayer.BinSymbol(Index:=1).Index = 10
  29.         ClassedPostLayer.BinSymbol(Index:=1).FillColorRGBA.Color = srfColorGreen
  30. '第2类,尺码0.20。
  31.         ClassedPostLayer.BinSymbol(Index:=2).Size = 0.20
  32. '第3类,(Magenta)品红线廓,(Cyan)青色填充,33号符,尺码0.32。
  33.         ClassedPostLayer.BinSymbol(Index:=3).LineColorRGBA.Color = srfColorMagenta
  34.         ClassedPostLayer.BinSymbol(Index:=3).FillColorRGBA.Color = srfColorCyan
  35.         ClassedPostLayer.BinSymbol(Index:=3).Index = 33
  36.         ClassedPostLayer.BinSymbol(Index:=3).Size = 0.32
  37. '第4类,(Orange)橙色填充。
  38.         ClassedPostLayer.BinSymbol(Index:=4).FillColorRGBA.Color = srfColorOrange

  39. '分类符旋转60°
  40.         ClassedPostLayer.SymAngle = 60

  41. '工作表数据行频率=1。
  42.         ClassedPostLayer.SymFrequency = 1

  43. '标注旋转45°
  44.         ClassedPostLayer.LabelAngle =45

  45. '标注字体为(Times New Roman)。
  46.         ClassedPostLayer.LabelFont.Face = "Times New Roman"

  47. '标注格式为固定型,保留3位小数点。
  48.         ClassedPostLayer.LabelFormat.Type = srfLabFixed
  49.         ClassedPostLayer.LabelFormat.NumDigits = 3

  50. '标注引导线为(Blue)蓝色。
  51.         ClassedPostLayer.LabelLine.ForeColorRGBA.Color = srfColorBlue

  52. '标注引导线长0.5。
  53.         ClassedPostLayer.LabelLineLength = 0.5

  54. '标注平台:屏幕。
  55.         ClassedPostLayer.LabelPlane = srfPostScreen

  56. '标注位置:用户自定义。
  57.         ClassedPostLayer.LabelPos = srfPostPosUser

  58. '标注相对于分类符偏移:x=0.25,y=-0.25。
  59.         ClassedPostLayer.LabelXOffset = 0.25
  60.         ClassedPostLayer.LabelYOffset = -0.25

  61. '载入分类散点类别文件:SurferApp.Path+"\samples\demogrid.cls"。
  62. ClassedPostLayer.LoadClasses(SurferApp.Path+"\samples\demogrid.cls")

  63. '显示分类标签图例。
  64.         ClassedPostLayer.ShowLegend = True

  65. '声明并设置分类图例。
  66.         Dim PostLegend As Object
  67.         Set PostLegend = ClassedPostLayer.Legend

  68. '图例标注字体: "Arial",固定型格式,保留小数点3位,尺码与场景一致,反向排序。
  69.         PostLegend.LabelFont.Face = "Arial"
  70.         PostLegend.LabelFormat.Type = srfLabFixed
  71.         PostLegend.LabelFormat.NumDigits = 3
  72.         PostLegend.SymbolSizeMethod = srfPostSizePlot
  73.         PostLegend.ReverseOrder = True

  74. '图例框纯色填充,(Cyan)青色。线框(NavyBlue)海军蓝,线宽0.03,圆角。页边距0.25。标题"Legend Title",字号16,加粗,(Orange)橙色。
  75.         PostLegend.FrameFill.Pattern = "Solid"
  76.         PostLegend.FrameFill.ForeColorRGBA.Color = srfColorCyan
  77.         PostLegend.FrameLine.ForeColorRGBA.Color = srfColorNavyBlue
  78.         PostLegend.FrameLine.Width = 0.03
  79.         PostLegend.FrameStyle = srfLegFrameRounded
  80.         PostLegend.Margins = 0.25
  81.         PostLegend.Title = "Legend Title"
  82.         PostLegend.TitleFont.Size = 16
  83.         PostLegend.TitleFont.Bold = True
  84.         PostLegend.TitleFont.ForeColorRGBA.Color = srfColorOrange

  85. '图例左上角(3,3)。
  86.         PostLegend.Top = 3
  87.         PostLegend.Left = 3

  88. '图形倾斜15,旋转40。
  89.         MapFrame.ViewTilt = 15
  90.         MapFrame.ViewRotation = 40

  91. '图层不透明度为 50%
  92.         ClassedPostLayer.Opacity = 50

  93. End Sub
复制代码
1.png

1.jpg
疑问:
'分类方法:用户自定义。注:此分类不可用,查了14版手册,将其改成了数值“3”,同样没有改变。图中分类与代码定义不同。
        ClassedPostLayer.BinningMethod =srfPostUser

'设置8个双精度分类锚点。
        Dim binlimits(1 To 8) As Double
        binlimits(1) = 25 : binlimits(2) = 50
        binlimits(3) = 50 : binlimits(4) = 75
        binlimits(5) = 75 : binlimits(6) = 100
        binlimits(7) = 100 : binlimits(8) = 110

        ClassedPostLayer.SetBinLimits(Limits:=binlimits)
@holz  @言深深

分类散点图.ClassedPostMap.bas

3.97 KB, 下载次数: 1, 下载积分: 金钱 -5

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

新浪微博达人勋

发表于 2017-4-7 10:55:04 | 显示全部楼层
大老鹰 发表于 2017-4-7 09:18
疑问:
'分类方法:用户自定义。注:此分类不可用,查了14版手册,将其改成了数值“3”,同样没有改 ...

不是不起作用,是后面的设置把前面的自定义设置给覆盖了:


  1. '载入分类散点类别文件:SurferApp.Path+"\samples\demogrid.cls"。
  2. ClassedPostLayer.LoadClasses(SurferApp.Path+"\samples\demogrid.cls")
复制代码
密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2017-4-7 11:22:34 | 显示全部楼层
holz 发表于 2017-4-7 10:55
不是不起作用,是后面的设置把前面的自定义设置给覆盖了:

非常感谢指点
密码修改失败请联系微信:mofangbao

新浪微博达人勋

 楼主| 发表于 2017-4-7 11:27:40 | 显示全部楼层
holz 发表于 2017-4-7 10:55
不是不起作用,是后面的设置把前面的自定义设置给覆盖了:

收集、整理了您的一些学习资料。

Holz网友作品集.rar

6.77 MB, 下载次数: 22, 下载积分: 金钱 -5

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

新浪微博达人勋

 楼主| 发表于 2017-4-7 12:11:34 | 显示全部楼层

  1. Sub Main

  2. '源代码来自Surfer13自带样本库,老鹰进行了中文标注。边译边学,毗漏难免,欢迎交流指正。
  3. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
  4.         Dim SurferApp As Object
  5.         Set SurferApp = CreateObject("Surfer.Application")
  6.         SurferApp.Visible = True

  7. '声明场景为对象。新建场景文件。
  8.         Dim Plot As Object
  9.         Set Plot = SurferApp.Documents.Add

  10. '添加影像图为图形,文件路径:SurferApp.Path+"\samples\demogrid.grd"
  11.         Set MapFrame = Plot.Shapes.AddImageMap(SurferApp.Path+"\samples\demogrid.grd")

  12. '声明影像图层为对象,设置它为第1图层。
  13.         Dim ImageLayer As Object
  14.         Set ImageLayer = MapFrame.Overlays(1)

  15. '声明彩色图为对象,设置影像图层为彩色图。
  16.         Dim ColorMap As Object
  17.         Set ColorMap = ImageLayer.ColorMap

  18. '设置彩色光谱数据范围:15-112)。
  19.         ColorMap.SetDataLimits (DataMin:=15, DataMax:=112)

  20. '设置6个色谱锚点。解释:将色谱起点看作0,终点为1,按照比例分配锚点位置。“0.1”在该处代表的数据是“15+(112-15)*10%”。
  21. 'The data position is recorded as a value from 0.0 (minimum) to 1.0 (maximum).
  22.         Dim Positions(6) As Double
  23.         Positions(0)=0.0
  24.         Positions(1)=0.1
  25.         Positions(2)=0.25
  26.         Positions(3)=0.5
  27.         Positions(4)=0.75
  28.         Positions(5)=0.9
  29.         Positions(6)=1.0
  30. '设置6个色谱锚点颜色。
  31.         Dim Colors(6) As Long
  32.         Colors(0)=srfColorBlack
  33.         Colors(1)=srfColorBlue
  34.         Colors(2)=srfColorGreen
  35.         Colors(3)=srfColorYellow
  36.         Colors(4)=srfColorOrange
  37.         Colors(5)=srfColorRed
  38.         Colors(6)=srfColorWhite

  39.         ColorMap.SetNodes(Positions:=Positions, Colors:=Colors)

  40. '将色谱保存为CLR文件,输出路径及文件名:SurferApp.Path+"\Samples\Personal.clr。
  41.         ColorMap.SaveFile(FileName:=SurferApp.Path+"\Samples\Personal.clr")

  42. '加载刚才保存的CLR文件,文件路径:SurferApp.Path+"\Samples\Personal.clr。
  43.         ImageLayer.ColorMap.LoadFile (FileName:=SurferApp.Path+"\Samples\Personal.clr")

  44. '色谱颠倒、逆转。
  45.         ImageLayer.ColorMap.Reverse

  46. '图形左上角图纸坐标(1,10.75)。
  47.         MapFrame.Top = 10.75
  48.         MapFrame.Left = 1

  49. '添加等值线图为第2图形,文件路径:SurferApp.Path+"\samples\demogrid.grd"。
  50.         Set MapFrame2 = Plot.Shapes.AddContourMap(SurferApp.Path+"\samples\demogrid.grd")

  51. '第2图形左上角图纸坐标(1,5.25)。
  52.         MapFrame2.Top = 5.25
  53.         MapFrame2.Left = 1

  54. '声明等值线图为对象,设置它为第2图形第1图层。
  55.         Dim ContourMap As Object
  56.         Set ContourMap = MapFrame2.Overlays(1)
  57. '填充等值线图,加载色谱文件:SurferApp.Path+"\ColorScales\Rainbow.clr"。
  58. '等值线层级填充参数解释。ContourMap.ApplyFillToLevels(1, 1, 0),
  59. '括号第1个数表示第1层就开始彩色填充,数值可修改;
  60. '第2个数“1”表示开启彩色连续填充,"0"表示关闭;
  61. '第三个3“1”表示开启相间填充,"0"表示关闭。
  62.         ContourMap.FillContours = True
  63.         ContourMap.FillForegroundColorMap.LoadFile(SurferApp.Path+"\ColorScales\Rainbow.clr")
  64.         ContourMap.ApplyFillToLevels(1, 1, 0)

  65. '反转颜色填充。
  66.     ContourMap.FillForegroundColorMap.Reverse
  67. End Sub
复制代码


彩色地图色谱文件.ColorMap CLR file.bas

2.78 KB, 下载次数: 4, 下载积分: 金钱 -5

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

新浪微博达人勋

 楼主| 发表于 2017-4-8 11:59:15 | 显示全部楼层
本帖最后由 大老鹰 于 2017-4-9 18:33 编辑
  1. Sub Main

  2. '源代码来自Surfer13自带样本库,老鹰进行了中文标注。边译边学,毗漏难免,欢迎交流指正。
  3. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
  4. '声明场景为对象。新建场景文件。
  5.         Dim SurferApp As Object
  6.         Set SurferApp = CreateObject("Surfer.Application")
  7.         SurferApp.Visible = True
  8.         Dim Plot As Object
  9.         Set Plot = SurferApp.Documents.Add

  10. '声明图形1为对象,加载等值线地图,文件来自:SurferApp.Path+"\Samples\demogrid.grd"。
  11. '定义等值线图层为对象,设其为图形1第1图层。
  12.         Dim MapFrame1 As Object
  13.         Set MapFrame1 = Plot.Shapes.AddContourMap(SurferApp.Path+"\Samples\demogrid.grd")
  14.         Dim ContourLayer As Object
  15.         Set ContourLayer = MapFrame1.Overlays(1)
  16. '简单分层方法。填充等值线。加载前景颜色预设色谱文件"Rainbow",背景颜色色谱预设文件"Terrain"。
  17.         ContourLayer.LevelMethod = SrfConLevelMethodSimple(0)
  18.     ContourLayer.FillContours = True
  19.     ContourLayer.FillForegroundColorMap.LoadPreset ("Rainbow")
  20.     ContourLayer.FillBackgroundColorMap.LoadPreset ("Terrain")

  21. '声明图形2为对象,加载影像地图,文件来自:SurferApp.Path+"\Samples\demogrid.grd"。
  22. '定义影像图层为对象,设其为图形2第1图层。
  23. '填充等值线。加载颜色预设色谱文件"Blues3"。
  24.         Dim MapFrame2 As Object
  25.         Set MapFrame2 = Plot.Shapes.AddImageMap(SurferApp.Path+"\Samples\demogrid.grd")
  26.         Dim ImageLayer As Object
  27.         Set ImageLayer = MapFrame2.Overlays(1)
  28.         ImageLayer.ColorMap.LoadPreset("Blues3")

  29. '声明图形3为对象,加载3D曲面图,文件来自:SurferApp.Path+"\Samples\demogrid.grd"。
  30. '定义3D曲面图层为对象,设其为图形3第1图层。
  31. '加载顶面色谱预设文件"Accents"。
  32.         Dim MapFrame3 As Object
  33.         Set MapFrame3 = Plot.Shapes.AddSurface(SurferApp.Path+"\Samples\demogrid.grd")
  34.         Dim SurfaceLayer As Object
  35.         Set SurfaceLayer = MapFrame3.Overlays(1)
  36.         SurfaceLayer.UpperColorMap.LoadPreset("Accents")

  37. '声明图形4为对象,加载网格矢量地图,文件来自:SurferApp.Path+"\Samples\demogrid.grd"。
  38. '定义矢量图层为对象,设其为图形4第1图层。
  39. '按照幅度大小进行颜色定标缩放。加载矢量颜色预设色谱文件"YellowJacket"
  40.         Dim MapFrame4 As Object
  41.         Set MapFrame4 = Plot.Shapes.AddVectorMap(SurferApp.Path+"\Samples\demogrid.grd")
  42.         Dim VectorLayer As Object
  43.         Set VectorLayer = MapFrame4.Overlays(1)
  44.         VectorLayer.ColorScaleMethod = srfVecMagnitude
  45.         VectorLayer.ColorMap.LoadPreset("YellowJacket")

  46. '声明图形5为对象,加载立体阴影地貌图,文件来自:SurferApp.Path+"\Samples\demogrid.grd"。
  47. '立体阴影地貌图层为对象,设其为图形5第1图层。
  48. '加载色谱预设文件"Geology"。
  49.         Dim MapFrame5 As Object
  50.         Set MapFrame5 = Plot.Shapes.AddReliefMap(SurferApp.Path+"\Samples\demogrid.grd")
  51.         Dim ReliefLayer As Object
  52.         Set ReliefLayer = MapFrame5.Overlays(1)
  53.         ReliefLayer.ColorMap.LoadPreset("Geology")

  54. End Sub
复制代码

加载彩色地图色谱预设文件.ColorMap LoadPreset.bas

2.64 KB, 下载次数: 1, 下载积分: 金钱 -5

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

新浪微博达人勋

 楼主| 发表于 2017-4-8 12:02:44 | 显示全部楼层
本帖最后由 大老鹰 于 2017-4-9 18:32 编辑

无标题.png
@holz 请教老师,上一楼等值线的前景和背景色谱文件均可以加载,为什么需要点击“确定”方可应用呢?
4.9已经解决上述问题,原脚本缺少等值线分层方法。
  1. '简单分层方法。
  2.         ContourLayer.LevelMethod = SrfConLevelMethodSimple(0)
复制代码

还有一点,官方脚本中预设的对角线填充不可用,只能用纯色填充,不知是何缘故?
  1. ContourLayer.FillPattern = "Diagonal Cross"
复制代码


感谢拨冗指导。

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

新浪微博达人勋

 楼主| 发表于 2017-4-8 15:59:43 | 显示全部楼层
本帖最后由 大老鹰 于 2017-4-13 12:54 编辑
  1. Sub Main

  2. '源代码来自Surfer13自带样本库,老鹰进行了中文标注。边译边学,毗漏难免,欢迎交流指正。
  3. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
  4.         Dim SurferApp As Object
  5.         Set SurferApp = CreateObject("Surfer.Application")
  6.         SurferApp.Visible = True

  7. '声明场景为对象。新建场景文件。
  8.         Dim Plot As Object
  9.         Set Plot = SurferApp.Documents.Add

  10. '创建影像图为图形,文件路径:SurferApp.Path+"\samples\demogrid.grd"
  11.         Set MapFrame = Plot.Shapes.AddImageMap(SurferApp.Path+"\samples\demogrid.grd")

  12. '声明影像图层为对象,将其设为图形第1图层。
  13.         Dim ImageLayer As Object
  14.         Set ImageLayer = MapFrame.Overlays(1)

  15. '图层用色谱预设文件"Rainbow"渲染。显示比色刻度尺。
  16.         ImageLayer.ColorMap.LoadPreset("Rainbow")
  17.          ImageLayer.ShowColorScale = True

  18. '声明比连续色刻度尺为对象。
  19.         Dim ContinuousColorScale As Object
  20.         Set ContinuousColorScale = ImageLayer.ColorScale

  21. '设置比色刻度尺属性。线框(Green)绿色,线宽0.02。
  22.          ContinuousColorScale.FrameLine.ForeColorRGBA.Color = srfColorGreen
  23.          ContinuousColorScale.FrameLine.Width = 0.02
  24. '标注字号18,颜色(Magenta)品红。固定型,保留小数点后4位。
  25.          ContinuousColorScale.LabelFont.Size = 18
  26.         ContinuousColorScale.LabelFont.ForeColorRGBA.Color = srfColorMagenta
  27.         ContinuousColorScale.LabelFormat.Type = srfLabFixed
  28.         ContinuousColorScale.LabelFormat.NumDigits = 4
  29. '标注旋转10,间隔15。最小值45,最大值90。
  30.         ContinuousColorScale.LabelAngle = 10
  31.          ContinuousColorScale.LabelInterval = 15
  32.          ContinuousColorScale.LabelMaximum = 90
  33.         ContinuousColorScale.LabelMinimum = 45

  34. '比色刻度尺标题"Contours Elevation",(Red)红色,左侧显示。
  35.     ContinuousColorScale.Title = "Contours Elevation"
  36.         ContinuousColorScale.TitleFont.ForeColorRGBA.Color = srfColorRed
  37.         ContinuousColorScale.TitlePosition = srfColorScaleTitlePositionLeft

  38. '标题偏移页面单位,水平0.13,垂直1.22。
  39.         ContinuousColorScale.TitleOffsetHorizontal = 0.13
  40.         ContinuousColorScale.TitleOffsetVertical = 1.22

  41. '标题选择90。
  42.         ContinuousColorScale.TitleAngle = 90

  43. '比色刻度尺左上角页面坐标(8,9)。
  44.         ContinuousColorScale.Top = 8
  45.         ContinuousColorScale.Left = 9

  46. End Sub
复制代码

多色渐变刻度尺.ContinuousColorScale.BAS

2.09 KB, 下载次数: 1, 下载积分: 金钱 -5

密码修改失败请联系微信:mofangbao
您需要登录后才可以回帖 登录 | 立即注册 新浪微博登陆

本版积分规则

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

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

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