专栏名称: 酒醒梦已残
酒醒梦已残系列视频教程涉及地质、物化探、水工环及三维建模内容,详细剖析了mapgis、surfer、voxler、Arcgis及三维建模软件等在地学中的应用,课程从基础出发,结合实际工作中的案例,汇集10年工作经验之精华。
目录
相关文章推荐
专注业绩潜伏  ·  人形机器人概念最全个股 ·  昨天  
专注业绩潜伏  ·  人形机器人概念最全个股 ·  昨天  
IPO早知道  ·  IPO周报 | ... ·  3 天前  
水木纪要  ·  AI服务器电源调研纪要,需求高速增长! ·  6 天前  
水木纪要  ·  AI服务器电源调研纪要,需求高速增长! ·  6 天前  
新声Pro  ·  进击的「抖次元」 ·  1 周前  
新声Pro  ·  进击的「抖次元」 ·  1 周前  
51好读  ›  专栏  ›  酒醒梦已残

【Surfer】93.快速选择网格化方法的一种方式

酒醒梦已残  · 公众号  · 科技创业 科技自媒体  · 2024-11-13 20:24

正文

【创作不易,记得关注、点赞、分享、收藏】

'通过循环使用 12 种不同的网格化算法对输入数据文件的指定列进行网格化处理,并生成一系列对应的等值线线地图
'方便用户直观地对比不同网格化方法得到的结果,可用于数据分析、地理信息系统等相关领域中对数据进行网格化处理及可视化展示的需求。
'地图大小和等值线图位置可以自己调整
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







观看更多酒醒梦已残在线视频和课件,请点击下方的阅读原文,加入酒醒梦已残地学实战训练营获取。