Surfer13自带脚本库中文标注

大老鹰

1. Sub Main
   
2. Debug.Clear
   
3. 
   
4. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
5. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
6.         Dim SurferApp As Object
   
7.         Set SurferApp = CreateObject("Surfer.Application")
   
8.         SurferApp.Visible = True
   
9. 
   
10. '声明场景为对象。新建场景文件。
    
11.         Dim Plot As Object
    
12.         Set Plot = SurferApp.Documents.Add
    
13. 
    
14. '设置输入、输出文件路径。输入数据文件DataFile，输出格网文件OutGrid。
    
15. '输入断层线文件Faultfile，白化文件BlankFile，输出空白格网文件BlankedGrid 。
    
16.         DataFile = SurferApp.Path + "\samples\demogrid.dat"
    
17.         OutGrid = SurferApp.Path + "\samples\demofault.grd"
    
18.         Faultfile = SurferApp.Path + "\samples\demoslice.bln"
    
19.         BlankFile = SurferApp.Path + "\samples\demorect.bln"
    
20.         BlankedGrid = SurferApp.Path + "\samples\demoblanked.grd"
    
21. 
    
22. '数据化算法：最小曲率法。行=200，列=200。不显示网格报告。断层文件名"Faultfile"，输出文件名"OutGrid"。
    
23.         SurferApp.GridData (DataFile:=DataFile, Algorithm:= srfMinCurvature, _
    
24.         NumRows:=200, NumCols:=200, ShowReport:=False, FaultFileName:=Faultfile, OutGrid:=OutGrid)
    
25. 
    
26. '白化格网文件。（输入格网文件名"OutGrid"，白化文件名"BlankFile"，输出白化网格文件名"BlankedGrid"）。
    
27.         SurferApp.GridBlank (InGrid:=OutGrid, BlankFile:=BlankFile, Outgrid:=BlankedGrid)
    
28. 
    
29. '声明图像为对象。设置等高线图为图形，输入格网文件"BlankedGrid"。
    
30.         Dim MapFrame As Object
    
31.         Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=BlankedGrid)
    
32. 
    
33. '改变图形范围（X极小、极大值；Y极小、极大值）。图形比例尺，X长度6，Y长度4。）
    
34.         MapFrame.SetLimits (xMin:=0.5, xMax:=4.5, yMin:=0.5, yMax:=3.5)
    
35.         MapFrame.xLength=6
    
36.         MapFrame.yLength=4
    
37. 
    
38. '声明等值线图为对象，将其设为图形第1图层，更名为"Topography Contour Map"。
    
39.         Dim ContourLayer As Object
    
40.         Set ContourLayer = MapFrame.Overlays(1)
    
41.         ContourLayer.Name = "Topography Contour Map"
    
42. 
    
43. '高平滑处理。
    
44.         ContourLayer.SmoothContours = srfConSmoothHigh
    
45. 
    
46. '断层线(Red)红色，线宽0.05。<font color="Red">线型"Dash Dot Dot"（线型参数不可用，删除）</font>。
    
47.         ContourLayer.FaultLine.ForeColorRGBA.Color = srfColorRed
    
48.         ContourLayer.FaultLine.Width = 0.05
    
49. 
    
50. 
    
51. '白化区域填充青色(Cyan)，不透明度20%，纯色。
    
52.         ContourLayer.BlankFill.ForeColorRGBA.Color = srfColorCyan
    
53.         ContourLayer.BlankFill.ForeColorRGBA.Opacity = 20
    
54.         ContourLayer.BlankFill.Pattern = "Solid"
    
55. '白化区线条(Brown)棕色，纯色，线宽0.02。
    
56.         ContourLayer.BlankLine.ForeColorRGBA.Color = srfColorBrown
    
57.         ContourLayer.BlankLine.Style = "Solid"
    
58.         ContourLayer.BlankLine.Width = 0.02
    
59. 
    
60. '高级分层方法。
    
61.                 ContourLayer.LevelMethod = SrfConLevelMethodAdvanced（1）
    
62. 
    
63. '填充等值线。加载色谱预设颜色"Rainbow"。
    
64.         ContourLayer.FillContours = True
    
65.         ContourLayer.FillForegroundColorMap.LoadPreset("Rainbow")
    
66. 
    
67. '颜色数据限制范围（40～100）。
    
68.                 ContourLayer.FillForegroundColorMap.SetDataLimits (DataMin:=40, DataMax:=100)
    
69. 
    
70.         '设置锚点比例位置。设置锚点颜色。
    
71.                 Dim Positions(3) As Double
    
72.                 Positions(0)=0.0
    
73.                 Positions(1)=0.3
    
74.                 Positions(2)=0.6
    
75.                 Positions(3)=1.0
    
76. 
    
77.                 Dim Colors(3) As Long
    
78.                 Colors(0)=srfColorBlack
    
79.                 Colors(1)=srfColorOrange
    
80.                 Colors(2)=srfColorCyan
    
81.                 Colors(3)=srfColorYellow
    
82. 
    
83.                 ContourLayer.FillForegroundColorMap.SetNodes(Positions:=Positions, Colors:=Colors)
    
84. 
    
85.         '色谱颠倒、逆转。
    
86.                 ContourLayer.FillForegroundColorMap.Reverse
    
87. 
    
88. 
    
89. '设置标注属性。曲率公差8，标注到标注间距0.25，标注到边界距离1.5。
    
90. '标注格式固定型，保留小数点后2位。标注方向向上，字体"Arial"，字号8。
    
91.         ContourLayer.LabelTolerance = 8
    
92.         ContourLayer.LabelLabelDist = 0.25
    
93.         ContourLayer.LabelEdgeDist = 1.5
    
94.         ContourLayer.LabelFormat.Type=srfLabFixed
    
95.         ContourLayer.LabelFormat.NumDigits = 2
    
96.         ContourLayer.OrientLabelsUphill = True
    
97.         ContourLayer.LabelFont.Face = "Arial"
    
98.         ContourLayer.LabelFont.Size = 8
    
99. 
    
100. '显示比色刻度尺。
     
101.         ContourLayer.ShowColorScale=True
     
102. 
     
103. '声明比色刻度尺为对象，标题"Contours Elevation"。
     
104.         Dim DiscreteColorScale As Object
     
105.         Set DiscreteColorScale = ContourLayer.ColorScale
     
106.         DiscreteColorScale.Title = "Contours Elevation"
     
107. 
     
108. '等高线输出为DXF文件，路径：SurferApp.Path+"\Samples\Contours.dxf"。
     
109.         ContourLayer.ExportContours(FileName:=SurferApp.Path+"\Samples\Contours.dxf", Format:=srfConFormatDXF)
     
110. 
     
111. '等值线左上角图纸坐标（7,0.5）。图层不透明度50%。
     
112.         MapFrame.Top=7
     
113.         MapFrame.Left=0.5
     
114.         ContourLayer.Opacity = 50
     
115. 
     
116. End Sub
     

复制代码

大老鹰

1. Sub Main
   
2. Debug.Clear
   
3. 
   
4. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
5. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
6.         Dim SurferApp As Object
   
7.         Set SurferApp = CreateObject("Surfer.Application")
   
8.         SurferApp.Visible = True
   
9. 
   
10. '声明场景为对象。新建场景文件。
    
11.         Dim Plot As Object
    
12.         Set Plot = SurferApp.Documents.Add
    
13. 
    
14. '声明图形为对象。
    
15.         Dim MapFrame As Object
    
16. 
    
17. '创建等值线地图，文件路径：SurferApp.Path + "\samples\demogrid.grd。
    
18.         Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=SurferApp.Path + "\samples\demogrid.grd")
    
19. 
    
20. '声明等值线图为对象，将其设为图形第1图层。
    
21.         Dim ContourLayer As Object
    
22.         Set ContourLayer = MapFrame.Overlays(1)
    
23. 
    
24. '分层方法：高级设置。
    
25.         ContourLayer.LevelMethod = SrfConLevelMethodAdvanced
    
26. 
    
27. '填充等值线。
    
28.         ContourLayer.FillContours = True
    
29. 
    
30.     '预设色谱"Terrain"填充等值线。纯色。填充透明。
    
31.                 ContourLayer.FillForegroundColorMap.LoadPreset("Terrain")
    
32.                 ContourLayer.FillPattern = "Solid"
    
33.                 ContourLayer.FillTransparent = True
    
34. 
    
35.         '声明锚点为双精度数值，设定锚点比例位置为：0，0.3，0.6，1.0。
    
36.                 Dim Positions(3) As Double
    
37.                 Positions(0)=0.0
    
38.                 Positions(1)=0.3
    
39.                 Positions(2)=0.6
    
40.                 Positions(3)=1.0
    
41.     '声明颜色为长整型，设定对应锚点颜色为：Orange，Cyan，Green，Black。
    
42.                 Dim Colors(3) As Long
    
43.                 Colors(0)=srfColorOrange
    
44.                 Colors(1)=srfColorCyan
    
45.                 Colors(2)=srfColorGreen
    
46.                 Colors(3)=srfColorBlack
    
47. 
    
48.                 ContourLayer.FillForegroundColorMap.SetNodes(Positions:=Positions, Colors:=Colors)
    
49. 
    
50.         '等值线层级填充参数解释。ContourMap.ApplyFillToLevels(1, 1, 0)，
    
51.     '第1个数"1"表示第1层就开始彩色填充，数值可修改；
    
52.     '第2个数"1"表示开启彩色连续填充，"0"表示关闭；
    
53.     '第3个数"1"表示开启相间填充，"0"表示关闭。
    
54.                 ContourLayer.ApplyFillToLevels(1, 1, 0)
    
55. 
    
56. '设置层级属性。
    
57.         '第4层等值线(Magenta)品红,宽0.03；该层色带填充（Green）绿色。
    
58.                 ContourLayer.Levels(4).Line.ForeColorRGBA.Color = srfColorMagenta
    
59.                 ContourLayer.Levels(4).Line.Width = 0.03
    
60.                 ContourLayer.Levels(4).Fill.ForeColorRGBA.Color = srfColorGreen
    
61.     '第8层等值线(Pink)粉红,宽0.05；该层色带填充（Yellow）黄色。
    
62.                 ContourLayer.Levels(8).Line.ForeColorRGBA.Color = srfColorPink
    
63.                 ContourLayer.Levels(8).Line.Width = 0.05
    
64.                 ContourLayer.Levels(8).Fill.ForeColorRGBA.Color = srfColorYellow
    
65. 
    
66. '设置标注属性。
    
67.         '第1层开始显示，连续相间标注。
    
68.                 ContourLayer.Levels.SetLabelFrequency(FirstIndex:=1, NumberToSet:=1, NumberToSkip:=1)
    
69. 
    
70. '设置刻线。
    
71.         '第1层开始显示，连续相间设置。
    
72.                 ContourLayer.Levels.SetHachFrequency(FirstIndex:=1, NumberToSet:=1, NumberToSkip:=1)
    
73. 
    
74.         '关闭"仅封闭等值线设置刻线"，刻线朝山下（示坡线），刻线长0.05。
    
75.                 ContourLayer.HachClosedOnly = False
    
76.                 ContourLayer.HachDirection = srfConHachDownhill
    
77.                 ContourLayer.HachLength = 0.05
    
78. 
    
79. '保存设置为层级线文件，路径：SurferApp.Path+"\Samples\Example1.lvl"。
    
80.         ContourLayer.Levels.SaveFile(FileName:=SurferApp.Path+"\Samples\Example1.lvl")
    
81. 
    
82. '显示比色刻度尺。
    
83.         ContourLayer.ShowColorScale=True
    
84. 
    
85. End Sub
    

复制代码

大老鹰

1. Sub Main
   
2. Debug.Clear
   
3. 
   
4. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
5. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
6.         Dim SurferApp As Object
   
7.         Set SurferApp = CreateObject("Surfer.Application")
   
8.         SurferApp.Visible = True
   
9. 
   
10. '声明场景为对象。新建场景文件。
    
11.         Dim Plot As Object
    
12.         Set Plot = SurferApp.Documents.Add
    
13. 
    
14. '声明图形为对象。
    
15.         Dim MapFrame As Object
    
16. 
    
17. '添加等值线图，文件路径：SurferApp.Path + "\samples\VOC_Concentration_LogAsLinear.grd"。
    
18.         Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=SurferApp.Path + "\samples\VOC_Concentration_LogAsLinear.grd")
    
19. 
    
20. '声明等值线图为对象，将其设为图形第1图层。
    
21.         Dim ContourLayer As Object
    
22.         Set ContourLayer = MapFrame.Overlays(1)
    
23. 
    
24. '分层方法：对数设置。
    
25.         ContourLayer.LevelMethod = SrfConLevelMethodLogarithmic
    
26. 
    
27. '显示并设置等值线极值，十倍率辅助层次。
    
28.         Debug.Print ContourLayer.LevelMinimum
    
29.         Debug.Print ContourLayer.LevelMaximum
    
30.         Debug.Print ContourLayer.LevelsInDecade
    
31. 
    
32.         ContourLayer.SetLogarithmicLevels(Min:=ContourLayer.LevelMinimum, Max:=ContourLayer.LevelMaximum, LevelsInDecade:=9)
    
33. 
    
34. '填充等值线。加载预设色谱"Rainbow3"。
    
35.         ContourLayer.FillContours = True
    
36.         ContourLayer.FillForegroundColorMap.LoadPreset("Rainbow3")
    
37. 
    
38. '使用数据限制。
    
39.         Zmin = ContourLayer.Grid.zMin
    
40.         Zmax = ContourLayer.Grid.zMax
    
41.         ContourLayer.FillForegroundColorMap.SetDataLimits(zMin, zMax)
    
42. 
    
43. '设置对数显示比色刻度尺。
    
44.          ContourLayer.FillForegroundColorMap.ScalingMethod = srfColorScalingLog
    
45. 
    
46. '显示比色刻度尺颜色。
    
47.         ContourLayer.ShowColorScale=True
    
48. 
    
49. '主要等值线(Red)红色。次要等值线(Pink)粉色。
    
50.         ContourLayer.MajorLine.ForeColorRGBA.Color = srfColorRed
    
51.         ContourLayer.MinorLine.ForeColorRGBA.Color = srfColorPink
    
52. 
    
53. '不显示主要等值线标注。显示次要等值线标注
    
54.         ContourLayer.ShowMajorLabels = False
    
55.         ContourLayer.ShowMinorLabels = True
    
56. 
    
57. '标注字体"Times New Roman"。
    
58.         ContourLayer.LabelFont.Face = "Times New Roman"
    
59. 
    
60. '5位标注有效显示数字。
    
61.         ContourLayer.LabelFormat.NumDigits = 5
    
62. 
    
63. '字头向上。
    
64.         ContourLayer.OrientLabelsUphill = True
    
65. 
    
66. End Sub
    

复制代码

大老鹰

1. Sub Main
   
2. Debug.Clear
   
3. 
   
4. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
5. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
6.         Dim SurferApp As Object
   
7.         Set SurferApp = CreateObject("Surfer.Application")
   
8.         SurferApp.Visible = True
   
9. 
   
10. '声明场景为对象。新建场景文件。
    
11.         Dim Plot As Object
    
12.         Set Plot = SurferApp.Documents.Add
    
13. 
    
14. '声明图形为对象。
    
15.         Dim MapFrame As Object
    
16. 
    
17. '创建等值线地图，文件路径：SurferApp.Path + "\samples\demogrid.grd。
    
18.         Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=SurferApp.Path + "\samples\demogrid.grd")
    
19. 
    
20. '声明等值线图为对象，将其设为图形第1图层。
    
21.         Dim ContourLayer As Object
    
22.         Set ContourLayer = MapFrame.Overlays(1)
    
23. 
    
24. '分层方法：简单设置。
    
25.         ContourLayer.LevelMethod = SrfConLevelMethodSimple
    
26. 
    
27. '显示设定等值线极值（25，100），等值距4。
    
28.         Debug.Print ContourLayer.LevelMinimum
    
29.         Debug.Print ContourLayer.LevelMaximum
    
30.         Debug.Print ContourLayer.LevelInterval
    
31. 
    
32.     ContourLayer.SetSimpleLevels(Min:=25, Max:=100, Interval:=4)
    
33. 
    
34. '主要等值线间距2。填充等值线。
    
35.         ContourLayer.LevelMajorInterval = 2
    
36.         ContourLayer.FillContours = True
    
37. 
    
38. '填充预设色谱模式"Rainbow3"。
    
39.         ContourLayer.FillForegroundColorMap.LoadPreset("Rainbow3")
    
40. 
    
41. '显示比色刻度尺。
    
42.         ContourLayer.ShowColorScale=True
    
43. 
    
44. '主要等值线(Red)红色，次要等值线粉色(Pink)。
    
45.         ContourLayer.MajorLine.ForeColorRGBA.Color = srfColorRed
    
46.         ContourLayer.MinorLine.ForeColorRGBA.Color = srfColorPink
    
47. 
    
48. '不显示主要等值线标注，显示次要等值线标注。
    
49.         ContourLayer.ShowMajorLabels = False
    
50.         ContourLayer.ShowMinorLabels = True
    
51. 
    
52. '标注字体"Times New Roman"。
    
53.         ContourLayer.LabelFont.Face = "Times New Roman"
    
54. 
    
55. '标注保留5位有效数字。
    
56.         ContourLayer.LabelFormat.NumDigits = 5
    
57. 
    
58. '字头朝上。
    
59.         ContourLayer.OrientLabelsUphill = True
    
60. 
    
61. End Sub
    

复制代码

大老鹰

1. Sub Main
   
2. 
   
3. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
4. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
5. '声明场景为对象。
   
6.         Dim SurferApp As Object
   
7.         Set SurferApp = CreateObject("Surfer.Application")
   
8.         SurferApp.Visible = True
   
9.         Dim Plot As Object
   
10. 
    
11. '光达文件路径："C:\libLAS_1.2.las"
    
12.         LASFile = "C:\libLAS_1.2.las"
    
13. 
    
14. '设置工作表打开光达数据。
    
15. '空间过滤选项，X最小1440000，X最大1444999。清除其它分类，只导入第1类。
    
16.         Set Wks = SurferApp.Documents.Open (FileName:= LASFile, _
    
17.         Options:="AcceptXMin=1440000, AcceptXMax=1444999, AcceptNthPoint = 5, AcceptNoClasses =0, AcceptClass[1]=1" )
    
18. 
    
19. End Sub
    

复制代码

注意：将文件 libLAS_1.2.las 放到C盘下

大老鹰

1. Sub Main
   
2. 
   
3. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
4. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
5.         Dim SurferApp As Object
   
6.         Set SurferApp = CreateObject("Surfer.Application")
   
7.         SurferApp.Visible = True
   
8. 
   
9. '声明场景为对象。新建场景文件。
   
10.         Dim Plot As Object
    
11.         Set Plot = SurferApp.Documents.Add
    
12. 
    
13. '声明图形为对象。
    
14.         Dim MapFrame As Object
    
15. 
    
16. '创建等值线地图，文件路径：SurferApp.Path+"\samples\Helens2.grd"。
    
17.         Set MapFrame = Plot.Shapes.AddContourMap(GridFileName:=SurferApp.Path+"\samples\Helens2.grd")
    
18. 
    
19. '声明等值线图为对象，将其设为图形第1图层。
    
20.         Dim ContourLayer As Object
    
21.         Set ContourLayer = MapFrame.Overlays(1)
    
22. 
    
23. '显示图形原坐标系统。
    
24.         Debug.Print "Original Coordinate System: " + MapFrame.CoordinateSystem
    
25. 
    
26. '设定图层坐标系统为"North America NAD27 UTM zone 10N"。
    
27.         ContourLayer.CoordinateSystem = "North America NAD27 UTM zone 10N"
    
28. 
    
29. '改变图形坐标系统为"World Geodetic System 1984"。
    
30.         MapFrame.CoordinateSystem = "World Geodetic System 1984"
    
31. 
    
32. '加载整个新格网文件，若设置为"True"则只加载引导文件。路径：SurferApp.Path+"\samples\colorado.grd"。
    
33.         Set grid = SurferApp.NewGrid
    
34.         grid.LoadFile(SurferApp.Path+"\samples\colorado.grd", False)
    
35. 
    
36.         '设定格网坐标系统"World Geodetic System 1984"。
    
37.         '保存路径：SurferApp.Path+"\samples\colorado_wgs_84.grd",格式Surfer7网格。
    
38.         grid.CoordinateSystem = "World Geodetic System 1984"
    
39.         grid.SaveFile(FileName:=SurferApp.Path+"\samples\colorado_wgs_84.grd", Format:=srfGridFmtS7)
    
40. 
    
41. End Sub
    

复制代码

吴东佑

好东西，感谢楼主

大老鹰

1. Sub Main
   
2. 
   
3. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
4. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
5.         Dim SurferApp As Object
   
6.         Set SurferApp = CreateObject("Surfer.Application")
   
7.         SurferApp.Visible = True
   
8. 
   
9. '声明场景为对象。新建场景文件。
   
10.         Dim Plot As Object
    
11.         Set Plot = SurferApp.Documents.Add
    
12. 
    
13. '创建影像图为图形，文件路径：SurferApp.Path+"\samples\demogrid.grd"
    
14.         Set MapFrame = Plot.Shapes.AddImageMap(SurferApp.Path+"\samples\demogrid.grd")
    
15. 
    
16. '声明影像图层为对象，将其设为图形第1图层。
    
17.         Dim ImageLayer As Object
    
18.         Set ImageLayer = MapFrame.Overlays(1)
    
19. 
    
20. '填充等值线。加载预设色谱"Rainbow"。
    
21.         ContourLayer.FillContours = True
    
22.         ContourLayer.FillForegroundColorMap.LoadPreset("Rainbow")
    
23. 
    
24. '显示比色刻度尺。声明比色刻度尺为对象。
    
25.         ContourLayer.ShowColorScale=True
    
26.          Dim DiscreteColorScale As Object
    
27. 
    
28. '设置离散刻度尺。
    
29.         Set DiscreteColorScale = ContourLayer.ColorScale
    
30. 
    
31. '刻度尺线框(NavyBlue)海军蓝，字号12，加粗。
    
32.         DiscreteColorScale.FrameLine.ForeColorRGBA.Color = srfColorNavyBlue
    
33.         DiscreteColorScale.LabelFont.Size = 12
    
34.         DiscreteColorScale.LabelFont.Bold = True
    
35. 
    
36. '标注格式固定型，保留小数点后2位，首行1，频率2。
    
37.         DiscreteColorScale.LabelFormat.Type=srfLabFixed
    
38.         DiscreteColorScale.LabelFormat.NumDigits = 2
    
39.         DiscreteColorScale.FirstLabel = 1
    
40.         DiscreteColorScale.LabelFrequency = 2
    
41. 
    
42. '标注标题"Contours Elevation"。字体(Red)红色。左侧。
    
43.                 DiscreteColorScale.Title = "Contours Elevation"
    
44.                 DiscreteColorScale.TitleFont.ForeColorRGBA.Color = srfColorRed
    
45.                 DiscreteColorScale.TitlePosition = srfColorScaleTitlePositionLeft
    
46. 
    
47.         '水平偏移0.13，垂直偏移1.22。旋转90。
    
48.                 DiscreteColorScale.TitleOffsetHorizontal = 0.13
    
49.                 DiscreteColorScale.TitleOffsetVertical = 1.22
    
50.                 DiscreteColorScale.TitleAngle = 90
    
51. 
    
52. '比色刻度尺左上角页面坐标(7.5,7.5)。
    
53.         DiscreteColorScale.Left = 7.5
    
54.         DiscreteColorScale.Top = 7.5
    
55. 
    
56. End Sub
    

复制代码

大老鹰

1. Sub Main
   
2. 
   
3. '源代码来自Surfer13自带样本库，老鹰进行了中文标注。边译边学，毗漏难免，欢迎交流指正。
   
4. '设置Surfer程序为创建对象。声明文档为对象。设置Surfer程序可见。
   
5.         Dim SurferApp As Object
   
6.         Set SurferApp = CreateObject("Surfer.Application")
   
7.         SurferApp.Visible = True
   
8. 
   
9. '声明场景为对象。新建场景文件。
   
10.         Dim Plot As Object
    
11.         Set Plot = SurferApp.Documents.Add
    
12. 
    
13. '声明文本为对象。
    
14.     Dim Text As Object
    
15. '创建文本1"This is my text",坐标（0.5,3）。字号18，加粗，字体"Italic"。
    
16.         Set Text1 = Plot.Shapes.AddText(x:=0.5, y:=3, Text:="This is my text")
    
17.         Text1.Font.Size = 18
    
18.         Text1.Font.Bold = True
    
19.         Text1.Font.Italic = True
    
20. '创建文本2"This is my text"回车符与换行符连接在一起"This is my text on the second line"，坐标(2,0.5)。
    
21. '文本水平居中，垂直居中。字号16。(Green)绿色。
    
22.     Set Text2 = Plot.Shapes.AddText(x:=2, y:=0.5, Text:="This is my text"& vbCrLf & "This is my text on the second line")
    
23.         Text2.Font.HAlign = srfTACenter
    
24.         Text2.Font.VAlign = srfTAVCenter
    
25.         Text2.Font.Size=16
    
26.         Text2.Font.ForeColorRGBA.Color=srfColorGreen
    
27. 
    
28. '声明符号为对象。创建符号，坐标(2,2)，第12号符，大小0.4，填充(Magenta)品红，线框(Magenta)品红。
    
29.         Dim Symbol As Object
    
30.         Set Symbol = Plot.Shapes.AddSymbol(x:=2, y:=2)
    
31.         Symbol.Marker.Index = 12
    
32.         Symbol.Marker.Size = 0.4
    
33.         Symbol.Marker.FillColorRGBA.Color=srfColorMagenta
    
34.         Symbol.Marker.LineColorRGBA.Color = srfColorMagenta
    
35. 
    
36. '创建矩形，四边坐标(0.5,7.5,1.5,10.5)。线框(Purple)紫色，线宽0.015。
    
37. '纯色填充，背景(LightYellow)浅黄，前景(Green)绿。
    
38.         Set Rectangle=Plot.Shapes.AddRectangle(Left:=0.5, Bottom:=7.5, Right:=1.5, Top:=10.5)
    
39.         Rectangle.Line.ForeColorRGBA.Color=srfColorPurple
    
40.         Rectangle.Line.Width = 0.015
    
41.         Rectangle.Fill.Pattern="Solid"
    
42.         Rectangle.Fill.BackColorRGBA.Color = srfColorLightYellow
    
43.         Rectangle.Fill.ForeColorRGBA.Color = srfColorGreen
    
44. 
    
45. '创建圆角矩形。四边坐标(7,9,8,10.5)，圆角X半径0.3，Y半径0.3。
    
46. '线框(Magenta)品红，线宽0.03。填充图案(Swamp)沼泽，(Green)绿色。
    
47.         Set RoundedRectangle = Plot.Shapes.AddRectangle(Left:=7, Bottom:=9, Right:=8, Top:=10.5, xRadius:=0.3, yRadius:=0.3)
    
48.         RoundedRectangle.Line.ForeColorRGBA.Color = srfColorMagenta
    
49.         RoundedRectangle.Line.Width = 0.03
    
50.         RoundedRectangle.Fill.Pattern = "Swamp"
    
51.         RoundedRectangle.Fill.ForeColorRGBA.Color = srfColorForestGreen
    
52. 
    
53. '创建椭圆，四至坐标(6.5,5.5,8,8)，填充(Solid)纯色，(Blue)蓝色。
    
54.     Set Ellipse = Plot.Shapes.AddEllipse(Left:=6.5, Bottom:=5.5, Right:=8, Top:=8)
    
55.     Ellipse.Fill.Pattern = "Solid"
    
56.         Ellipse.Fill.ForeColorRGBA.Color = srfColorBlue
    
57. 
    
58. '创建单段线，起点(2,8.5)，终点(3.5,10.5)。紫色，线宽0.04，连续线段。
    
59.     Set Polyline = Plot.Shapes.AddLine(xBeg:=2, yBeg:=8.5, xEnd:=3.5, yEnd:=10.5)
    
60.     Polyline.Line.ForeColorRGBA.Color = srfColorPurple
    
61.     Polyline.Line.Width = 0.04
    
62.     Polyline.Line.Style = "Solid"
    
63. 
    
64. '声明多段线拐点坐标组为双精度数值。坐标(4,10.5)(6.5,10)(5,9)(6,8.5)。
    
65.         Dim PolyLineArray(7) As Double
    
66.         PolyLineArray(0) = 4:        PolyLineArray(1) = 10.5
    
67.         PolyLineArray(2) = 6.5:        PolyLineArray(3) = 10
    
68.         PolyLineArray(4) = 5:        PolyLineArray(5) = 9
    
69.         PolyLineArray(6) = 6:        PolyLineArray(7) = 8.5
    
70. 
    
71.         '创建贝叶斯曲线，红色，0.03，连续线段。
    
72.         Set Spline = Plot.Shapes.AddPolyLine2(PolyLineArray, srfPTBezier)
    
73.         Spline.Line.ForeColorRGBA.Color = srfColorRed
    
74.         Spline.Line.Width = 0.03
    
75.         Spline.Line.Style = "Solid"
    
76.     '声明曲线顶点坐标为双精度数值。
    
77.         Dim Vertices() As Double
    
78.         Vertices() = Spline.Vertices
    
79. 
    
80.         '创建多段线，蓝色。声明多段线顶点坐标为双精度数值。
    
81.         Set PolyLine = Plot.Shapes.AddPolyLine2(PolyLineArray, srfPTPolyline)
    
82.         PolyLine.Line.ForeColorRGBA.Color = srfColorBlue
    
83.         Dim Vertices2() As Double
    
84.         Vertices2() = PolyLine.Vertices
    
85. 
    
86.    '声明坐标数组为双精度数值。(4,4)(8,1)(5.5,0.5)。
    
87.         Dim Coordinates(5) As Double
    
88.         Coordinates(0) = 4: Coordinates(1) = 4
    
89.         Coordinates(2) = 8: Coordinates(3) = 1
    
90.         Coordinates(4) = 5.5: Coordinates(5) = 0.5
    
91.    '根据上述坐标创立多边形。现框(Blue)蓝色，线宽0.05。纯色填充，透明，(Orange)橘黄。
    
92.         Set Polygon = Plot.Shapes.AddPolygon(Coordinates)
    
93.         Polygon.Line.ForeColorRGBA.Color = srfColorBlue
    
94.         Polygon.Line.Width = 0.05
    
95.         Polygon.Fill.Pattern = "Solid"
    
96.         Polygon.Fill.Transparent = True
    
97.         Polygon.Fill.ForeColorRGBA.Color = srfColorOrange
    
98. 
    
99. '声明多边形顶点坐标为双精度数值。12个拐点坐标如下。
    
100.         Dim PgonCoordinates(23) As Double
     
101.         PgonCoordinates(0) = 3.44: PgonCoordinates(1) = 4.06
     
102.         PgonCoordinates(2) = 1.10: PgonCoordinates(3) = 6.39
     
103.         PgonCoordinates(4) = 3.44: PgonCoordinates(5) = 8.73
     
104.         PgonCoordinates(6) = 5.75: PgonCoordinates(7) = 6.39
     
105.         PgonCoordinates(8) = 3.36: PgonCoordinates(9) = 8.07
     
106.         PgonCoordinates(10) = 5.01: PgonCoordinates(11) = 6.42
     
107.         PgonCoordinates(12) = 3.36: PgonCoordinates(13) = 4.75
     
108.         PgonCoordinates(14) = 1.71: PgonCoordinates(15) = 6.42
     
109.         PgonCoordinates(16) = 1.71: PgonCoordinates(17) = 8.07
     
110.         PgonCoordinates(18) = 5.01: PgonCoordinates(19) = 8.07
     
111.         PgonCoordinates(20) = 5.01: PgonCoordinates(21) = 4.75
     
112.         PgonCoordinates(22) = 1.71: PgonCoordinates(23) = 4.75
     
113.     '多边形0由前面四点坐标构成，多边形1由中间四点坐标构成，多边形2由最后四点坐标构成。
     
114.         Dim NumPolygons(2) As Long
     
115.         NumPolygons(0) = 4
     
116.         NumPolygons(1) = 4
     
117.         NumPolygons(2) = 4
     
118.     '设置组合多边形（顶点坐标=PgonCoordinates，多边形计数=NumPolygons）。
     
119.     '(Brown)棕线，线宽0.05，纯色填充。
     
120.         Set ComplexPolygon = Plot.Shapes.AddComplexPolygon(Vertices:=PgonCoordinates, PolyCounts:=NumPolygons)
     
121.         ComplexPolygon.Line.ForeColorRGBA.Color = srfColorBrown
     
122.         ComplexPolygon.Line.Width = 0.05
     
123.         ComplexPolygon.Fill.Pattern="Solid"
     
124. 
     
125. 
     
126. '创建组合对象。显示"Composite Object"。
     
127.         '文本2，坐标(6.25,3.75)，内容"Composite Object"。
     
128.         '创建矩形，四边坐标(6,3.25,8,4.25)。
     
129.         '两者选中，组合。
     
130.         Debug.Print "Composite Object"
     
131.         Set Text2 = Plot.Shapes.AddText(x:=6.25, y:=3.75, Text:="Composite Object")
     
132.         Set Rectangle2=Plot.Shapes.AddRectangle(Left:=6, Bottom:=3.25, Right:=8, Top:=4.25)
     
133.         Text2.Select
     
134.         Rectangle2.Select
     
135.         Set Composite = Plot.Selection.Combine
     
136. 
     
137.         '打散组合。
     
138.         Composite.BreakApart
     
139. 
     
140. End Sub
     

复制代码

fancyidea1

很强大！学习了