Surfer13自带脚本库中文标注

大老鹰 · 发表于 2017-4-6 13:01:50

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

您需要登录才可以下载或查看，没有帐号？立即注册

x

打算陆陆续续将Surfer13自带脚本库翻译完毕，请问在论坛以“代码”格式发帖，为什么不能正常显示？

大老鹰 · 发表于 2017-4-6 13:03:36

本帖最后由大老鹰于 2017-4-7 10:00 编辑

更新四个脚本。

大老鹰 · 发表于 2017-4-7 09:18:47

本帖最后由大老鹰于 2017-4-7 10:31 编辑

Sub Main
'源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
'设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
Dim SurferApp As Object
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
'声明场景为对象。新建场景文件。
Dim Plot As Object
Set Plot = SurferApp.Documents.Add
'添加分类散点图为图形，该文件路径：SurferApp.Path+"\Samples\demogrid.dat"。X、Y、Z列数据分别来自1、2、3栏，标注来自第3栏。
Set MapFrame = Plot.Shapes.AddClassedPostMap(DataFileName:=SurferApp.Path+"\Samples\demogrid.dat", xCol:= 1, yCol:=2, zCol:=3, LabCol:=3)
'声明分类散点图为对象。属于第1图层。
Dim ClassedPostLayer As Object
Set ClassedPostLayer = MapFrame.Overlays(1)
'分为4类。
ClassedPostLayer.NumClasses = 4
<font color="Red">'分类方法：用户自定义。此分类不可用，查了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)</font>
'设置分类符属性。第1类，尺码0.15，10号符，(Green)绿色。
ClassedPostLayer.BinSymbol(Index:=1).Size = 0.15
ClassedPostLayer.BinSymbol(Index:=1).Index = 10
ClassedPostLayer.BinSymbol(Index:=1).FillColorRGBA.Color = srfColorGreen
'第2类，尺码0.20。
ClassedPostLayer.BinSymbol(Index:=2).Size = 0.20
'第3类，(Magenta)品红线廓,（Cyan）青色填充，33号符，尺码0.32。
ClassedPostLayer.BinSymbol(Index:=3).LineColorRGBA.Color = srfColorMagenta
ClassedPostLayer.BinSymbol(Index:=3).FillColorRGBA.Color = srfColorCyan
ClassedPostLayer.BinSymbol(Index:=3).Index = 33
ClassedPostLayer.BinSymbol(Index:=3).Size = 0.32
'第4类，(Orange)橙色填充。
ClassedPostLayer.BinSymbol(Index:=4).FillColorRGBA.Color = srfColorOrange
'分类符旋转60°
ClassedPostLayer.SymAngle = 60
'工作表数据行频率=1。
ClassedPostLayer.SymFrequency = 1
'标注旋转45°
ClassedPostLayer.LabelAngle =45
'标注字体为(Times New Roman)。
ClassedPostLayer.LabelFont.Face = "Times New Roman"
'标注格式为固定型，保留3位小数点。
ClassedPostLayer.LabelFormat.Type = srfLabFixed
ClassedPostLayer.LabelFormat.NumDigits = 3
'标注引导线为（Blue）蓝色。
ClassedPostLayer.LabelLine.ForeColorRGBA.Color = srfColorBlue
'标注引导线长0.5。
ClassedPostLayer.LabelLineLength = 0.5
'标注平台：屏幕。
ClassedPostLayer.LabelPlane = srfPostScreen
'标注位置：用户自定义。
ClassedPostLayer.LabelPos = srfPostPosUser
'标注相对于分类符偏移：x=0.25，y=-0.25。
ClassedPostLayer.LabelXOffset = 0.25
ClassedPostLayer.LabelYOffset = -0.25
'载入分类散点类别文件：SurferApp.Path+"\samples\demogrid.cls"。
ClassedPostLayer.LoadClasses(SurferApp.Path+"\samples\demogrid.cls")
'显示分类标签图例。
ClassedPostLayer.ShowLegend = True
'声明并设置分类图例。
Dim PostLegend As Object
Set PostLegend = ClassedPostLayer.Legend
'图例标注字体： "Arial"，固定型格式，保留小数点3位，尺码与场景一致，反向排序。
PostLegend.LabelFont.Face = "Arial"
PostLegend.LabelFormat.Type = srfLabFixed
PostLegend.LabelFormat.NumDigits = 3
PostLegend.SymbolSizeMethod = srfPostSizePlot
PostLegend.ReverseOrder = True
'图例框纯色填充，(Cyan)青色。线框(NavyBlue)海军蓝，线宽0.03，圆角。页边距0.25。标题"Legend Title"，字号16，加粗，(Orange)橙色。
PostLegend.FrameFill.Pattern = "Solid"
PostLegend.FrameFill.ForeColorRGBA.Color = srfColorCyan
PostLegend.FrameLine.ForeColorRGBA.Color = srfColorNavyBlue
PostLegend.FrameLine.Width = 0.03
PostLegend.FrameStyle = srfLegFrameRounded
PostLegend.Margins = 0.25
PostLegend.Title = "Legend Title"
PostLegend.TitleFont.Size = 16
PostLegend.TitleFont.Bold = True
PostLegend.TitleFont.ForeColorRGBA.Color = srfColorOrange
'图例左上角(3,3)。
PostLegend.Top = 3
PostLegend.Left = 3
'图形倾斜15，旋转40。
MapFrame.ViewTilt = 15
MapFrame.ViewRotation = 40
'图层不透明度为 50%
ClassedPostLayer.Opacity = 50
End Sub

复制代码

疑问：
'分类方法：用户自定义。注：此分类不可用，查了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  @言深深

holz · 发表于 2017-4-7 10:55:04

大老鹰发表于 2017-4-7 09:18
疑问：
'分类方法：用户自定义。注：此分类不可用，查了14版手册，将其改成了数值“3”，同样没有改 ...

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

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

复制代码

大老鹰 · 发表于 2017-4-7 11:22:34

holz 发表于 2017-4-7 10:55
不是不起作用，是后面的设置把前面的自定义设置给覆盖了：

非常感谢指点

大老鹰 · 发表于 2017-4-7 11:27:40

holz 发表于 2017-4-7 10:55
不是不起作用，是后面的设置把前面的自定义设置给覆盖了：

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

大老鹰 · 发表于 2017-4-7 12:11:34

Sub Main
'源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
'设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
Dim SurferApp As Object
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
'声明场景为对象。新建场景文件。
Dim Plot As Object
Set Plot = SurferApp.Documents.Add
'添加影像图为图形，文件路径：SurferApp.Path+"\samples\demogrid.grd"
Set MapFrame = Plot.Shapes.AddImageMap(SurferApp.Path+"\samples\demogrid.grd")
'声明影像图层为对象，设置它为第1图层。
Dim ImageLayer As Object
Set ImageLayer = MapFrame.Overlays(1)
'声明彩色图为对象，设置影像图层为彩色图。
Dim ColorMap As Object
Set ColorMap = ImageLayer.ColorMap
'设置彩色光谱数据范围：15-112）。
ColorMap.SetDataLimits (DataMin:=15, DataMax:=112)
'设置6个色谱锚点。解释：将色谱起点看作0，终点为1，按照比例分配锚点位置。“0.1”在该处代表的数据是“15+（112-15）*10%”。
'The data position is recorded as a value from 0.0 (minimum) to 1.0 (maximum).
Dim Positions(6) As Double
Positions(0)=0.0
Positions(1)=0.1
Positions(2)=0.25
Positions(3)=0.5
Positions(4)=0.75
Positions(5)=0.9
Positions(6)=1.0
'设置6个色谱锚点颜色。
Dim Colors(6) As Long
Colors(0)=srfColorBlack
Colors(1)=srfColorBlue
Colors(2)=srfColorGreen
Colors(3)=srfColorYellow
Colors(4)=srfColorOrange
Colors(5)=srfColorRed
Colors(6)=srfColorWhite
ColorMap.SetNodes(Positions:=Positions, Colors:=Colors)
'将色谱保存为CLR文件，输出路径及文件名：SurferApp.Path+"\Samples\Personal.clr。
ColorMap.SaveFile(FileName:=SurferApp.Path+"\Samples\Personal.clr")
'加载刚才保存的CLR文件，文件路径：SurferApp.Path+"\Samples\Personal.clr。
ImageLayer.ColorMap.LoadFile (FileName:=SurferApp.Path+"\Samples\Personal.clr")
'色谱颠倒、逆转。
ImageLayer.ColorMap.Reverse
'图形左上角图纸坐标（1,10.75）。
MapFrame.Top = 10.75
MapFrame.Left = 1
'添加等值线图为第2图形，文件路径：SurferApp.Path+"\samples\demogrid.grd"。
Set MapFrame2 = Plot.Shapes.AddContourMap(SurferApp.Path+"\samples\demogrid.grd")
'第2图形左上角图纸坐标（1,5.25）。
MapFrame2.Top = 5.25
MapFrame2.Left = 1
'声明等值线图为对象，设置它为第2图形第1图层。
Dim ContourMap As Object
Set ContourMap = MapFrame2.Overlays(1)
'填充等值线图，加载色谱文件：SurferApp.Path+"\ColorScales\Rainbow.clr"。
'等值线层级填充参数解释。ContourMap.ApplyFillToLevels(1, 1, 0)，
'括号第1个数表示第1层就开始彩色填充，数值可修改；
'第2个数“1”表示开启彩色连续填充，"0"表示关闭；
'第三个3“1”表示开启相间填充，"0"表示关闭。
ContourMap.FillContours = True
ContourMap.FillForegroundColorMap.LoadFile(SurferApp.Path+"\ColorScales\Rainbow.clr")
ContourMap.ApplyFillToLevels(1, 1, 0)
'反转颜色填充。
ContourMap.FillForegroundColorMap.Reverse
End Sub

复制代码

大老鹰 · 发表于 2017-4-8 11:59:15

本帖最后由大老鹰于 2017-4-9 18:33 编辑

Sub Main
'源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
'设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
'声明场景为对象。新建场景文件。
Dim SurferApp As Object
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
Dim Plot As Object
Set Plot = SurferApp.Documents.Add
'声明图形1为对象，加载等值线地图，文件来自：SurferApp.Path+"\Samples\demogrid.grd"。
'定义等值线图层为对象，设其为图形1第1图层。
Dim MapFrame1 As Object
Set MapFrame1 = Plot.Shapes.AddContourMap(SurferApp.Path+"\Samples\demogrid.grd")
Dim ContourLayer As Object
Set ContourLayer = MapFrame1.Overlays(1)
'简单分层方法。填充等值线。加载前景颜色预设色谱文件"Rainbow"，背景颜色色谱预设文件"Terrain"。
ContourLayer.LevelMethod = SrfConLevelMethodSimple（0）
ContourLayer.FillContours = True
ContourLayer.FillForegroundColorMap.LoadPreset ("Rainbow")
ContourLayer.FillBackgroundColorMap.LoadPreset ("Terrain")
'声明图形2为对象，加载影像地图，文件来自：SurferApp.Path+"\Samples\demogrid.grd"。
'定义影像图层为对象，设其为图形2第1图层。
'填充等值线。加载颜色预设色谱文件"Blues3"。
Dim MapFrame2 As Object
Set MapFrame2 = Plot.Shapes.AddImageMap(SurferApp.Path+"\Samples\demogrid.grd")
Dim ImageLayer As Object
Set ImageLayer = MapFrame2.Overlays(1)
ImageLayer.ColorMap.LoadPreset("Blues3")
'声明图形3为对象，加载3D曲面图，文件来自：SurferApp.Path+"\Samples\demogrid.grd"。
'定义3D曲面图层为对象，设其为图形3第1图层。
'加载顶面色谱预设文件"Accents"。
Dim MapFrame3 As Object
Set MapFrame3 = Plot.Shapes.AddSurface(SurferApp.Path+"\Samples\demogrid.grd")
Dim SurfaceLayer As Object
Set SurfaceLayer = MapFrame3.Overlays(1)
SurfaceLayer.UpperColorMap.LoadPreset("Accents")
'声明图形4为对象，加载网格矢量地图，文件来自：SurferApp.Path+"\Samples\demogrid.grd"。
'定义矢量图层为对象，设其为图形4第1图层。
'按照幅度大小进行颜色定标缩放。加载矢量颜色预设色谱文件"YellowJacket"
Dim MapFrame4 As Object
Set MapFrame4 = Plot.Shapes.AddVectorMap(SurferApp.Path+"\Samples\demogrid.grd")
Dim VectorLayer As Object
Set VectorLayer = MapFrame4.Overlays(1)
VectorLayer.ColorScaleMethod = srfVecMagnitude
VectorLayer.ColorMap.LoadPreset("YellowJacket")
'声明图形5为对象，加载立体阴影地貌图，文件来自：SurferApp.Path+"\Samples\demogrid.grd"。
'立体阴影地貌图层为对象，设其为图形5第1图层。
'加载色谱预设文件"Geology"。
Dim MapFrame5 As Object
Set MapFrame5 = Plot.Shapes.AddReliefMap(SurferApp.Path+"\Samples\demogrid.grd")
Dim ReliefLayer As Object
Set ReliefLayer = MapFrame5.Overlays(1)
ReliefLayer.ColorMap.LoadPreset("Geology")
End Sub

复制代码

大老鹰 · 发表于 2017-4-8 12:02:44

本帖最后由大老鹰于 2017-4-9 18:32 编辑

无标题.png

@holz 请教老师，上一楼等值线的前景和背景色谱文件均可以加载，为什么需要点击“确定”方可应用呢？
4.9已经解决上述问题，原脚本缺少等值线分层方法。

'简单分层方法。
ContourLayer.LevelMethod = SrfConLevelMethodSimple（0）

复制代码

还有一点，官方脚本中预设的对角线填充不可用，只能用纯色填充，不知是何缘故？

ContourLayer.FillPattern = "Diagonal Cross"

复制代码

感谢拨冗指导。

大老鹰 · 发表于 2017-4-8 15:59:43

本帖最后由大老鹰于 2017-4-13 12:54 编辑

Sub Main
'源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
'设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
Dim SurferApp As Object
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
'声明场景为对象。新建场景文件。
Dim Plot As Object
Set Plot = SurferApp.Documents.Add
'创建影像图为图形，文件路径：SurferApp.Path+"\samples\demogrid.grd"
Set MapFrame = Plot.Shapes.AddImageMap(SurferApp.Path+"\samples\demogrid.grd")
'声明影像图层为对象，将其设为图形第1图层。
Dim ImageLayer As Object
Set ImageLayer = MapFrame.Overlays(1)
'图层用色谱预设文件"Rainbow"渲染。显示比色刻度尺。
ImageLayer.ColorMap.LoadPreset("Rainbow")
ImageLayer.ShowColorScale = True
'声明比连续色刻度尺为对象。
Dim ContinuousColorScale As Object
Set ContinuousColorScale = ImageLayer.ColorScale
'设置比色刻度尺属性。线框(Green)绿色，线宽0.02。
ContinuousColorScale.FrameLine.ForeColorRGBA.Color = srfColorGreen
ContinuousColorScale.FrameLine.Width = 0.02
'标注字号18，颜色(Magenta)品红。固定型，保留小数点后4位。
ContinuousColorScale.LabelFont.Size = 18
ContinuousColorScale.LabelFont.ForeColorRGBA.Color = srfColorMagenta
ContinuousColorScale.LabelFormat.Type = srfLabFixed
ContinuousColorScale.LabelFormat.NumDigits = 4
'标注旋转10，间隔15。最小值45，最大值90。
ContinuousColorScale.LabelAngle = 10
ContinuousColorScale.LabelInterval = 15
ContinuousColorScale.LabelMaximum = 90
ContinuousColorScale.LabelMinimum = 45
'比色刻度尺标题"Contours Elevation"，(Red)红色，左侧显示。
ContinuousColorScale.Title = "Contours Elevation"
ContinuousColorScale.TitleFont.ForeColorRGBA.Color = srfColorRed
ContinuousColorScale.TitlePosition = srfColorScaleTitlePositionLeft
'标题偏移页面单位，水平0.13，垂直1.22。
ContinuousColorScale.TitleOffsetHorizontal = 0.13
ContinuousColorScale.TitleOffsetVertical = 1.22
'标题选择90。
ContinuousColorScale.TitleAngle = 90
'比色刻度尺左上角页面坐标(8,9)。
ContinuousColorScale.Top = 8
ContinuousColorScale.Left = 9
End Sub

复制代码

		自动登录	找回密码
密码			立即注册

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

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

评分