用反距离加权算法插值出格网点高程
建立规则格网的DEM原数据是TXT文件已经TXT文件的高程点展在CAD上了，画好规则格网了 问题：（1）怎么记录这些离散点在哪个方格里（2）用反距离加权插值法计算格网点高程，4-6个离散点参与运算(怎么找出是那几个离散点，怎么记录这些离散点)设置d<20时是否满足4-6个点，满足则记录这些点（d为离散点到格网点距离）不满足时，将距离d+5或者d-5希望大家看到的，有些想法和思路的能够告诉我，谢谢！
Option Explicit
Dim L As Integer '离散点数量
Dim H() As Double, X() As Double, Y() As Double, Z() As Double '离散点号，x坐标，y坐标，z坐标
Dim dblD As Double '网格边长
Dim M As Integer '网格的列数
Dim N As Integer '网格的行数
Dim IREG() As Double '定义一个二维数组,存储网格中点的链表的第一个点号
Dim IP() As Long '设一个链数组，存储网格中点的链表的第二个点号至最后一个点号
Sub txt_read()
Dim txtname As String
Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double
dblD = 20
ReDim H(100), X(100), Y(100), Z(100)
'读取文件
L = 0 '初始值
Xmax = -1.7976931348623E+308: Xmin = 1.7976931348623E+308
Ymax = -1.7976931348623E+308: Ymin = 1.7976931348623E+308
Open "D:\Personal\Desktop\demdata.txt" For Input As #1 '打开输入文件
Do While Not EOF(1) '文件读取循环
If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100), Z(UBound(Z) + 100)
Input #1, H(L), X(L), Y(L), Z(L) '读取文件数据, H贮存点序号,XYZ为坐标
If X(L) >= Xmax Then
Xmax = X(L)
End If
If Y(L) >= Ymax Then
Ymax = Y(L)
End If
If X(L) <= Xmin Then
Xmin = X(L)
End If
If Y(L) <= Ymin Then
Ymin = Y(L)
End If
L = L + 1 '个数加1
Loop '文件读取循环
Close #1 '关闭文件
Open "D:\Personal\Desktop\zuizhi.txt" For Output As #1
Print #1, Xmax, Ymax, Xmin, Ymin
Close #1 '关闭文件
'绘制格网
Dim iAs Integer, j As Integer '设置两个i,j循环变量
Dim XlineObj As AcadLWPolyline '创建水平格数Xlineobj变量
Dim YlineObj As AcadLWPolyline '创建竖直格数Ylineobj 变量
Dim Xpoints(0 To 3) As Double
Dim Ypoints(0 To 3) As Double
N = Fix((Xmax - Xmin) / dblD) + 1
M = Fix((Ymax - Ymin) / dblD) + 1
'画水平上的方格总数
For i = 0 To M
Xpoints(0) = Xmin: Xpoints(1) = Ymin + dblD * i
Xpoints(2) = Xmin + N * dblD: Xpoints(3) = Xpoints(1)
Set XlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Xpoints)
Next
'画竖直上的方格总数
For j = 0 To N
Ypoints(0) = Xmin + dblD * j: Ypoints(1) = Ymin
Ypoints(2) = Xmin + dblD * j: Ypoints(3) = Ymin + dblD * M
Set YlineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Ypoints)
Next
'ZoomAll
End Sub
Sub RecordPointPosition() '记录点在哪个网格
Dim NX As Integer, NY As Integer '离散点所在网格的列'离散点所在网格的行
Dim Xmax As Double, Xmin As Double, Ymax As Double, Ymin As Double
Dim i As Integer, j As Integer
dblD = 20
Open "D:\Personal\Desktop\zuizhi.txt" For Input As #1 '打开输入文件
Input #1, Xmax, Ymax, Xmin, Ymin '读取文件数据
Close #1
ReDim IP(L), IREG(N - 1, M - 1)
'循环判断
For i = 0 To L - 1
'计算样点所在网格
NX = Fix((X(i) - Xmin) / dblD)
NY = Fix((Y(i) - Ymin) / dblD)
If IREG(NX, NY) = 0 Then
IREG(NX, NY) = H(i) '记录点号
Else
j = IREG(NX, NY)
'导找链表的末端
Do
If IP(j) = 0 Then
IP(j) = H(i) '记录点号
Exit Do
Else
j = IP(j)
End If
Loop
End If
Next i
End Sub
Public Sub ss() '测试运行
txt_read
RecordPointPosition
'以下检查点在网格中位置
Dim i As Integer, j As Integer
Dim intTmp As Integer
For i = 0 To N - 1
For j = 0 To M - 1
If IREG(i, j) <> 0 Then
intTmp = IREG(i, j)
Do
Debug.Print intTmp; ",";
intTmp = IP(intTmp)
Loop While intTmp > 0
Debug.Print , "在网格" & i & ":" & j & "内"
End If
Next j
Next i
End Sub
以上为第一个问题 zzyong00 发表于 2016-5-15 15:51 static/image/common/back.gif
以上为第一个问题
那我上次改的记录格网点的位置对吗 zzyong00 发表于 2016-5-15 15:51 static/image/common/back.gif
以上为第一个问题
If L > UBound(H) Then ReDim Preserve H(UBound(H) + 100), X(UBound(X) + 100), Y(UBound(Y) + 100), Z(UBound(Z) + 100)
这个是什么意思 馨馨 发表于 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个空间
页:
[1]