Sub Main
Dim SurferApp As Object
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
'指定地图高度
ylength = 5
'获取数据文件路径,支持多种文件格式(.dat、.csv、.xls、.xlsx)
Data$ = GetFilePath( , "dat;csv;xls;xlsx",path1, "Data file to grid")
If Data$ ="" Then End
Dim Doc As Object
Set Doc = SurferApp.Documents.Add
'设置数据列
xcol = Val(InputBox$("输入X所在列", "X列", "1"))
ycol = Val(InputBox$("输入Y所在列", "Y 列", "2"))
zcol = Val(InputBox$("输入Z所在列", "Z 列", "3"))
'1. Inverse Distance
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=1, OutGrid:=Data$+"_InverseDistance.grd")
Dim Map As Object
Set Map = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_InverseDistance.grd")
Map.yLength = ylength
Map.xMapPerPU = Map.yMapPerPU
If Map.Width < 5 Then Map.xMapPerPU = Map.yMapPerPU Else Map.xLength = 5
Map.Axes("Bottom Axis").Title = "Inverse Distance"
Map.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map.Left = 2
Map.Top = 11.0
'2. Kriging
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=2, OutGrid:=Data$+"_Kriging.grd")
Dim Map2 As Object
Set Map2 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_Kriging.grd")
Map2.yLength = ylength
Map2.xMapPerPU = Map.yMapPerPU
If Map2.Width < 5 Then Map2.xMapPerPU = Map2.yMapPerPU Else Map2.xLength = 5
Map2.Axes("Bottom Axis").Title = "Kriging"
Map2.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map2.Left = 8
Map2.Top = 11.0
'3. Minimum Curvature
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=3, OutGrid:=Data$+"_MinimumCurvature.grd")
Dim Map3 As Object
Set Map3 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_MinimumCurvature.grd")
Map3.yLength = ylength
Map3.xMapPerPU = Map.yMapPerPU
If Map3.Width < 5 Then Map3.xMapPerPU = Map3.yMapPerPU Else Map3.xLength = 5
Map3.Axes("Bottom Axis").Title = "Minimum Curvature"
Map3.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map3.Left = 15
Map3.Top = 11.0
'4. Modified Shepard's Method
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=4, OutGrid:=Data$+"_ModifiedShepard.grd")
Dim Map4 As Object
Set Map4 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_ModifiedShepard.grd")
Map4.yLength = ylength
Map4.xMapPerPU = Map.yMapPerPU
If Map4.Width < 5 Then Map4.xMapPerPU = Map4.yMapPerPU Else Map4.xLength = 5
Map4.Axes("Bottom Axis").Title = "Modified Shepard's Method"
Map4.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map4.Left = 0.25
Map4.Top = 8.23
'5. Natural Neighbor
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=5, OutGrid:=Data$+"_NaturalNeighbor.grd")
Dim Map5 As Object
Set Map5 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_NaturalNeighbor.grd")
Map5.yLength = ylength
Map5.xMapPerPU = Map.yMapPerPU
If Map5.Width < 5 Then Map5.xMapPerPU = Map5.yMapPerPU Else Map5.xLength = 5
Map5.Axes("Bottom Axis").Title = "Natural Neighbor"
Map5.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map5.Left = 2.99
Map5.Top = 8.23
'6. Nearest Neighbor
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=6, OutGrid:=Data$+"_NearestNeighbor.grd")
Dim Map6 As Object
Set Map6 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_NearestNeighbor.grd")
Map6.yLength = ylength
Map6.xMapPerPU = Map.yMapPerPU
If Map6.Width < 5 Then Map6.xMapPerPU = Map6.yMapPerPU Else Map6.xLength = 5
Map6.Axes("Bottom Axis").Title = "Nearest Neighbor"
Map6.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map6.Left = 5.74
Map6.Top = 8.23
'7. Polynomial Regression
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=7, OutGrid:=Data$+"_PolynomialRegression.grd")
Dim Map7 As Object
Set Map7 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_PolynomialRegression.grd")
Map7.yLength = ylength
Map7.xMapPerPU = Map.yMapPerPU
If Map7.Width < 5 Then Map7.xMapPerPU = Map7.yMapPerPU Else Map7.xLength = 5
Map7.Axes("Bottom Axis").Title = "Polynomial Regression"
Map7.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map7.Left = 0.25
Map7.Top = 5.35
'8. Radial Basis Function
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=8, OutGrid:=Data$+"_RadialBasisFunction.grd")
Dim Map8 As Object
Set Map8 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_RadialBasisFunction.grd")
Map8.yLength = ylength
Map8.xMapPerPU = Map.yMapPerPU
If Map8.Width < 5 Then Map8.xMapPerPU = Map8.yMapPerPU Else Map8.xLength = 5
Map8.Axes("Bottom Axis").Title = "Radial Basis Function"
Map8.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map8.Left = 2.99
Map8.Top = 5.35
'9. Triangulation with Linear Interpolation
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=9, OutGrid:=Data$+"_TriangulationLinearInterpolation.grd")
Dim Map9 As Object
Set Map9 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_TriangulationLinearInterpolation.grd")
Map9.yLength = ylength
Map9.xMapPerPU = Map.yMapPerPU
If Map9.Width < 5 Then Map9.xMapPerPU = Map9.yMapPerPU Else Map9.xLength = 5
Map9.Axes("Bottom Axis").Title = "Triangulation with Linear Interpolation"
Map9.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map9.Left = 5.74
Map9.Top = 5.35
'10. Moving Average
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=10, OutGrid:=Data$+"_MovingAverage.grd")
Dim Map10 As Object
Set Map10 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_MovingAverage.grd")
Map10.yLength = ylength
Map10.xMapPerPU = Map.yMapPerPU
If Map10.Width < 5 Then Map10.xMapPerPU = Map10.yMapPerPU Else Map10.xLength = 5
Map10.Axes("Bottom Axis").Title = "Moving Average"
Map10.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map10.Left = 0.25
Map10.Top = 2.57
'11. Data Metrics
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=11, DataMetric:=23, _
SearchEnable:=True, SearchNumSectors:=2, SearchRad1:=2000, SearchRad2:=1500, OutGrid:=Data$+"_DataMetrics.grd")
Dim Map11 As Object
Set Map11 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_DataMetrics.grd")
Map11.yLength = ylength
Map11.xMapPerPU = Map.yMapPerPU
If Map11.Width < 5 Then Map11.xMapPerPU = Map11.yMapPerPU Else Map11.xLength = 5
Map11.Axes("Bottom Axis").Title = "Data Metrics: Terrain Slope"
Map11.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map11.Left = 2.99
Map11.Top = 2.57
'12. Local Polynomial
SurferApp.GridData(DataFile:=Data$, xcol:=xcol, ycol:=ycol, zcol:=zcol, ShowReport:=False, Algorithm:=12, OutGrid:=Data$+"_LocalPolynomial.grd")
Dim Map12 As Object
Set Map12 = Doc.Shapes.AddContourMap(GridFileName:=Data$+"_LocalPolynomial.grd")
Map12.yLength = ylength
Map12.xMapPerPU = Map.yMapPerPU
If Map12.Width < 5 Then Map12.xMapPerPU = Map12.yMapPerPU Else Map12.xLength = 5
Map12.Axes("Bottom Axis").Title = "Local Polynomial"
Map12.Axes("Bottom Axis").TitleFont.ForeColorRGBA.Color = srfColorRed
Map12.Left = 5.74
Map12.Top = 2.57
End Sub