用反距离加权算法插值出格网点高程

馨馨

建立规则格网的DEM

原数据是TXT文件

已经TXT文件的高程点展在CAD上了，画好规则格网了

问题：（1）怎么记录这些离散点在哪个方格里

（2）用反距离加权插值法计算格网点高程，4-6个离散点参与运算(怎么找出是那几个离散点，怎么记录这些离散点)

设置d<20时是否满足4-6个点，满足则记录这些点（d为离散点到格网点距离）

不满足时，将距离d+5或者d-5

希望大家看到的，有些想法和思路的能够告诉我，谢谢！

zzyong00

1. Option Explicit
   
2. 
   
3. 
   
4. Dim L As Integer '离散点数量
   
5. Dim H() As Double, X() As Double, Y() As Double, Z() As Double '离散点号，x坐标，y坐标，z坐标
   
6. Dim dblD As Double '网格边长
   
7. Dim M As Integer    '网格的列数
   
8. Dim N As Integer    '网格的行数
   
9. Dim IREG() As Double    '定义一个二维数组,存储网格中点的链表的第一个点号
   
10. Dim IP() As Long    '设一个链数组，存储网格中点的链表的第二个点号至最后一个点号
    
11. 
    
12. Sub txt_read()
    
13. Dim txtname As String
    
14. 
    
15. Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double
    
16. dblD = 20
    
17. ReDim H(100), X(100), Y(100), Z(100)
    
18. 
    
19.     '读取文件
    
20.     L = 0    '初始值
    
21.     Xmax = -1.7976931348623E+308: Xmin = 1.7976931348623E+308
    
22.     Ymax = -1.7976931348623E+308: Ymin = 1.7976931348623E+308
    
23.     Open "D:\Personal\Desktop\demdata.txt" For Input As #1    '打开输入文件
    
24.     Do While Not EOF(1)    '文件读取循环
    
25.         If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100), Z(UBound(Z) + 100)
    
26. 
    
27.         Input #1, H(L), X(L), Y(L), Z(L)    '读取文件数据, H贮存点序号,XYZ为坐标
    
28. 
    
29.         If X(L) >= Xmax Then
    
30.             Xmax = X(L)
    
31.         End If
    
32.         If Y(L) >= Ymax Then
    
33.             Ymax = Y(L)
    
34.         End If
    
35.         If X(L) <= Xmin Then
    
36.             Xmin = X(L)
    
37.         End If
    
38.         If Y(L) <= Ymin Then
    
39.             Ymin = Y(L)
    
40.         End If
    
41.         L = L + 1    '个数加1
    
42. 
    
43.     Loop    '文件读取循环
    
44.     Close #1    '关闭文件
    
45. 
    
46.     Open "D:\Personal\Desktop\zuizhi.txt" For Output As #1
    
47.     Print #1, Xmax, Ymax, Xmin, Ymin
    
48.     Close #1    '关闭文件
    
49. 
    
50.     '绘制格网
    
51.     Dim i  As Integer, j As Integer      '设置两个i,j循环变量
    
52.     Dim XlineObj As AcadLWPolyline    '创建水平格数Xlineobj变量
    
53.     Dim YlineObj As AcadLWPolyline    '创建竖直格数Ylineobj 变量
    
54.     Dim Xpoints(0 To 3) As Double
    
55.     Dim Ypoints(0 To 3) As Double
    
56. 
    
57.     N = Fix((Xmax - Xmin) / dblD) + 1
    
58.     M = Fix((Ymax - Ymin) / dblD) + 1
    
59. 
    
60.     '画水平上的方格总数
    
61.     For i = 0 To M
    
62.         Xpoints(0) = Xmin: Xpoints(1) = Ymin + dblD * i
    
63.         Xpoints(2) = Xmin + N * dblD: Xpoints(3) = Xpoints(1)
    
64.         Set XlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Xpoints)
    
65.     Next
    
66.     '画竖直上的方格总数
    
67.     For j = 0 To N
    
68.         Ypoints(0) = Xmin + dblD * j: Ypoints(1) = Ymin
    
69.         Ypoints(2) = Xmin + dblD * j: Ypoints(3) = Ymin + dblD * M
    
70.         Set YlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Ypoints)
    
71.     Next
    
72.     'ZoomAll
    
73. End Sub
    
74. 
    
75. 
    
76. 
    
77. Sub RecordPointPosition() '记录点在哪个网格
    
78.     Dim NX As Integer, NY As Integer    '离散点所在网格的列'离散点所在网格的行
    
79.     Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double
    
80.     Dim i As Integer, j As Integer
    
81. 
    
82.     dblD = 20
    
83.     Open "D:\Personal\Desktop\zuizhi.txt" For Input As #1    '打开输入文件
    
84.     Input #1, Xmax, Ymax, Xmin, Ymin    '读取文件数据
    
85.     Close #1
    
86. 
    
87. 
    
88.     ReDim IP(L), IREG(N - 1, M - 1)
    
89. 
    
90.     '循环判断
    
91.     For i = 0 To L - 1
    
92.         '计算样点所在网格
    
93.         NX = Fix((X(i) - Xmin) / dblD)
    
94.         NY = Fix((Y(i) - Ymin) / dblD)
    
95.         If IREG(NX, NY) = 0 Then
    
96.             IREG(NX, NY) = H(i) '记录点号
    
97.         Else
    
98.             j = IREG(NX, NY)
    
99.             '导找链表的末端
    
100.             Do
     
101.                 If IP(j) = 0 Then
     
102.                     IP(j) = H(i) '记录点号
     
103.                     Exit Do
     
104.                 Else
     
105.                     j = IP(j)
     
106.                 End If
     
107.             Loop
     
108.             
     
109.         End If
     
110.     Next i
     
111. End Sub
     
112. 
     
113. Public Sub ss() '测试运行
     
114.     txt_read
     
115.     RecordPointPosition
     
116.    
     
117.     '以下检查点在网格中位置
     
118.     Dim i As Integer, j As Integer
     
119.     Dim intTmp As Integer
     
120.     For i = 0 To N - 1
     
121.         For j = 0 To M - 1
     
122.             If IREG(i, j) <> 0 Then
     
123.                 intTmp = IREG(i, j)
     
124.                 Do
     
125.                     Debug.Print intTmp; ",";
     
126.                     intTmp = IP(intTmp)
     
127.                 Loop While intTmp > 0
     
128.             
     
129.                 Debug.Print , "在网格" & i & ":" & j & "内"
     
130.             End If
     
131.         Next j
     
132.     Next i
     
133. End Sub
     
134. 
     

Option Explicit<br /> <br /> <br /> Dim L As Integer '离散点数量<br /> Dim H() As Double, X() As Double, Y() As Double, Z() As Double '离散点号，x坐标，y坐标，z坐标<br /> Dim dblD As Double '网格边长<br /> Dim M As Integer    '网格的列数<br /> Dim N As Integer    '网格的行数<br /> Dim IREG() As Double    '定义一个二维数组,存储网格中点的链表的第一个点号<br /> Dim IP() As Long    '设一个链数组，存储网格中点的链表的第二个点号至最后一个点号<br /> <br /> Sub txt_read()<br /> Dim txtname As String<br /> <br /> Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double<br /> dblD = 20<br /> ReDim H(100), X(100), Y(100), Z(100)<br /> <br />     '读取文件<br />     L = 0    '初始值<br />     Xmax = -1.7976931348623E+308: Xmin = 1.7976931348623E+308<br />     Ymax = -1.7976931348623E+308: Ymin = 1.7976931348623E+308<br />     Open "D:\Personal\Desktop\demdata.txt" For Input As #1    '打开输入文件<br />     Do While Not EOF(1)    '文件读取循环<br />         If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100), Z(UBound(Z) + 100)<br /> <br />         Input #1, H(L), X(L), Y(L), Z(L)    '读取文件数据, H贮存点序号,XYZ为坐标<br /> <br />         If X(L) >= Xmax Then<br />             Xmax = X(L)<br />         End If<br />         If Y(L) >= Ymax Then<br />             Ymax = Y(L)<br />         End If<br />         If X(L) <= Xmin Then<br />             Xmin = X(L)<br />         End If<br />         If Y(L) <= Ymin Then<br />             Ymin = Y(L)<br />         End If<br />         L = L + 1    '个数加1<br /> <br />     Loop    '文件读取循环<br />     Close #1    '关闭文件<br /> <br />     Open "D:\Personal\Desktop\zuizhi.txt" For Output As #1<br />     Print #1, Xmax, Ymax, Xmin, Ymin<br />     Close #1    '关闭文件<br /> <br />     '绘制格网<br />     Dim i  As Integer, j As Integer      '设置两个i,j循环变量<br />     Dim XlineObj As AcadLWPolyline    '创建水平格数Xlineobj变量<br />     Dim YlineObj As AcadLWPolyline    '创建竖直格数Ylineobj 变量<br />     Dim Xpoints(0 To 3) As Double<br />     Dim Ypoints(0 To 3) As Double<br /> <br />     N = Fix((Xmax - Xmin) / dblD) + 1<br />     M = Fix((Ymax - Ymin) / dblD) + 1<br /> <br />     '画水平上的方格总数<br />     For i = 0 To M<br />         Xpoints(0) = Xmin: Xpoints(1) = Ymin + dblD * i<br />         Xpoints(2) = Xmin + N * dblD: Xpoints(3) = Xpoints(1)<br />         Set XlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Xpoints)<br />     Next<br />     '画竖直上的方格总数<br />     For j = 0 To N<br />         Ypoints(0) = Xmin + dblD * j: Ypoints(1) = Ymin<br />         Ypoints(2) = Xmin + dblD * j: Ypoints(3) = Ymin + dblD * M<br />         Set YlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Ypoints)<br />     Next<br />     'ZoomAll<br /> End Sub<br /> <br /> <br /> <br /> Sub RecordPointPosition() '记录点在哪个网格<br />     Dim NX As Integer, NY As Integer    '离散点所在网格的列'离散点所在网格的行<br />     Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double<br />     Dim i As Integer, j As Integer<br /> <br />     dblD = 20<br />     Open "D:\Personal\Desktop\zuizhi.txt" For Input As #1    '打开输入文件<br />     Input #1, Xmax, Ymax, Xmin, Ymin    '读取文件数据<br />     Close #1<br /> <br /> <br />     ReDim IP(L), IREG(N - 1, M - 1)<br /> <br />     '循环判断<br />     For i = 0 To L - 1<br />         '计算样点所在网格<br />         NX = Fix((X(i) - Xmin) / dblD)<br />         NY = Fix((Y(i) - Ymin) / dblD)<br />         If IREG(NX, NY) = 0 Then<br />             IREG(NX, NY) = H(i) '记录点号<br />         Else<br />             j = IREG(NX, NY)<br />             '导找链表的末端<br />             Do<br />                 If IP(j) = 0 Then<br />                     IP(j) = H(i) '记录点号<br />                     Exit Do<br />                 Else<br />                     j = IP(j)<br />                 End If<br />             Loop<br />             <br />         End If<br />     Next i<br /> End Sub<br /> <br /> Public Sub ss() '测试运行<br />     txt_read<br />     RecordPointPosition<br />     <br />     '以下检查点在网格中位置<br />     Dim i As Integer, j As Integer<br />     Dim intTmp As Integer<br />     For i = 0 To N - 1<br />         For j = 0 To M - 1<br />             If IREG(i, j) <> 0 Then<br />                 intTmp = IREG(i, j)<br />                 Do<br />                     Debug.Print intTmp; ",";<br />                     intTmp = IP(intTmp)<br />                 Loop While intTmp > 0<br />             <br />                 Debug.Print , "在网格" & i & ":" & j & "内"<br />             End If<br />         Next j<br />     Next i<br /> End Sub<br /> <br />

zzyong00

以上为第一个问题

馨馨

zzyong00 发表于 2016-5-15 15:51
以上为第一个问题

那我上次改的记录格网点的位置对吗

馨馨

zzyong00 发表于 2016-5-15 15:51
以上为第一个问题

If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100), Z(UBound(Z) + 100)
这个是什么意思

zzyong00

馨馨 发表于 2016-5-16 08:40
If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100),  ...

如果点数多，原来定义的数组不够大，就再增加100个空间