纯干货！示范程序源程序！

程序运行前需完成如下准备工作：

1、下载原始数据文件，并将解压出相应的数据文件：

h0.txt、R001.TXT和TOPO.dat；

2、本示范程序默认数据文件读取路径为C盘根目录，因此需要将数据文件按原文件名直接拷贝至C盘根目录下，效果截图如下：

其中：

h0.txt：ITU P.839.4 所附带的数据文件，包含有高于平均海平面的年平均0°C等温线数据。
R001.TXT：ITUP.837.7 所附带的数据文件，包含有超过年平均降雨率0.01%的年降雨率数据。
TOPO.dat：ITUP.1511 所附带的数据文件，包含有海拔数据，
完成上述工作后，打开EXCEL文件，输入经纬度后，点击获取数据即可。注：程序主要示范精确取值功能，因此对所有非网格点数据均采用双插值四点法取值推算，ITU P.1511建议处理海拔数据采用双三插值16点法取值推算。
程序运行效果如下：
相关源程序如下：
Public Bilinear_value As Double
Public Function Bilinear(Row_int,Column_int, Row_frac, Column_frac, Step_1, File_name_1)
Dim Data(2, 2) As Double
Dim Diff_row, Diff_col As Double
Diff_row = Row_int - Row_frac
Diff_col = Column_int - Column_frac
On Error GoTo b
Open File_name_1 For Input As #1
'第一种情况，纬度和经度符合数据库间距，可定位至一个点，直接取该点的值
If Diff_row = 0 And Dif_Col = 0 Then
For i = 1 To Row_int - 1
Line Input #1, test
Next
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Bilinear_value = Val(test)
Close #1
Exit Function
End If
'第二种情况，纬度符合数据库间距，可定位至两个点，取值并计算
If Diff_row = 0 Then
For i = 1 To Row_int - 1
Line Input #1, test
Next
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Data(1, 1) = Val(test)
Input #1, test
Data(1, 2) = Val(test)
Bilinear_value = Data(1, 1) * (Diff_col + 1) + Data(1, 2) * (-Diff_col)
Close #1
Exit Function
End If
'第三种情况，经度符合数据库间距，可定位至两个点，取值并计算
If Diff_col = 0 Then
For i = 1 To Row_int - 1
Line Input #1, test
Next
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Data(1, 1) = Val(test)
Line Input #1, test
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Data(2, 1) = Val(test)
Bilinear_value = Data(1, 1) * (Diff_row + 1) + Data(2, 1) * (-Diff_row)
Close #1
Exit Function
End If
'第四种情况，都不符合数据库间距，定位至四个点，取值并计算
For i = 1 To Row_int - 1
Line Input #1, test
Next
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Data(2, 1) = test
Input #1, test
Data(2, 2) = test
Line Input #1, test
For i = 1 To Column_int - 1
Input #1, test
Next
Input #1, test
Data(1, 1) = test
Input #1, test
Data(1, 2) = test
Bilinear_value = Data(1, 1) * (Diff_row + 1) * (Diff_col + 1) + Data(2,1) * (-Diff_row) * (Diff_col + 1) + Data(1, 2) * (1 + Diff_row) * (-Diff_col) +Data(2, 2) * (-Diff_row) * (-Diff_col)
Close #1
Exit Function
b:         MsgBox '相关文件不存在！'
Bilinear_value = -100
End Function
'-----------
'----修改编辑完成后将下列行替换 Sub 数字地图取值()并将文件另存为 新文件名如 数字地图取值1.0
'Private Sub Auto_open()
Sub 数字地图取值()
Load UserForm1
UserForm1.Show
End Sub
Private Sub CommandButton1_Click()
Dim Row_int_index, Column_int_index,Row_frac_index, Column_frac_index, Lat, Lon, Lat_trans, Lon_trans, Step AsDouble
Dim File_name As String
Lat = Val(纬度.Value)
Lon = Val(经度.Value)
If Lat > 90 Or Lat < -90 Then
MsgBox '请检查相关数据！'
Exit Sub
ElseIf Lon > 180 Or Lon < -180 Then
MsgBox '请检查相关数据！'
Exit Sub
End If
'839-降雨高度
Step = 1.5
Lat_trans = Lat
Row_frac_index = (90 - Lat_trans) / Step +1
Row_int_index = Fix((90 - Lat_trans) /Step) + 1
If Lon > 0 Then
Lon_trans = Lon
Else
Lon_trans = Lon + 360
End If
Column_frac_index = Lon_trans / Step + 1
Column_int_index = Fix(Lon_trans / Step) +1
File_name = 'C:\h0.txt'
Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)
降雨高度.Value = Int(Bilinear_value *1000) / 1000
If Bilinear_value = -100 Then
Bilinear_value = ' '
Exit Sub
End If
'837-降雨量
Step = 0.125
Lat_trans = Lat
Row_frac_index = (90 + Lat_trans) / Step +1
Row_int_index = Fix((90 + Lat_trans) /Step) + 1
Lon_trans = Lon + 180
Column_frac_index = Lon_trans / Step + 1
Column_int_index = Fix(Lon_trans / Step) +1
File_name = 'C:\R001.txt'
Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)
降雨量.Value = Int(Bilinear_value *1000) / 1000
If Bilinear_value = -100 Then
Bilinear_value = ' '
Exit Sub
End If
'1511海拔高度
Step = 1 / 12
Lat_trans = Lat + 0.125
Row_frac_index = (90 - Lat_trans) / Step +3
Row_int_index = Fix((90 - Lat_trans) /Step) + 3
Lon_trans = Lon - 0.04166 + 180
Column_frac_index = Lon_trans / Step + 3
Column_int_index = Fix(Lon_trans / Step) +3
File_name = 'C:\TOPO.dat'
Call Bilinear(Row_int_index,Column_int_index, Row_frac_index, Column_frac_index, Step, File_name)
海拔高度.Value = Int(Bilinear_value) /1000
End Sub
如果大家有问题或者是有不懂得方面欢迎私信一起讨论~
赞 (0)

相关推荐