因为你读取的是 MAPGIS, 每个图数据量庞大, 而错误线少,
所以我反过来编, 是
循序读入 GIS 数据, 才检查是否要删除, 马上输出该线至 3.txt,
而不是
读入错误Z线数据, 而每次搜寻GIS数据,更改,再保存.
Sub GGGG()
Dim Path, ObjId, x, y As String
Dim a As String, m, n As Long
Dim Lines As Long, nLine As Long
Dim InputPts As Long, OutputPts As Long, sx As String, sy As String
Dim ptXY(255)
On Error Resume Next
On Error GoTo 0
DoCmd.RunSQL "Drop table InvalidPt"
DoCmd.RunSQL "create table InvalidPt (objid text(3), x text(20), y text(20))"
Path = "D:\Backup\我的文档\AccessSoft\"
Open Path & "2.txt" For Input As #2
a = ""
Do While Not a Like "-----*"
Line Input #2, a
Loop
Line Input #2, a
DoCmd.SetWarnings False
Do While Not a Like "-----*"
ObjId = ParseN(a)
ObjId = ParseN(a)
x = ParseN(a)
y = ParseN(a)
DoCmd.RunSQL "Insert into InvalidPt values ('" & ObjId & "','" & x & "','" & y & "')"
Line Input #2, a
Loop
DoCmd.SetWarnings True
Close #2
Open Path & "1.txt" For Input As #1
Open Path & "3.txt" For Output As #3
Line Input #1, a '默认前两行为一样的输出
Print #3, a
Line Input #1, a '第二行为线数
Lines = Val(a) - 1
Print #3, a
For nLine = 1 To Lines
Line Input #1, a '每条线的颜色，层次，宽度等参数, 不作修改直接保存
Print #3, a
Line Input #1, a '读入点数
InputPts = Val(a)
OutputPts = InputPts
For n = 1 To InputPts '此循环读入所有点
Line Input #1, ptXY(n) ' 读入一点
Next
Line Input #1, a 'ObjId 行
ObjId = Left(a, InStr(a, ",") - 1)
For n = 1 To InputPts '此循环检查每一点是否要删除
m = InStr(ptXY(n), ",")
sx = Left(ptXY(n), m - 1 - 1) '错误节点是 5位小数的
sy = Mid(ptXY(n), m + 1, Len(ptXY(n)) - m - 1) '错误节点是 5位小数的
If Not IsNull(DLookup("[x]", "InvalidPt", "[ObjId]='" & ObjId & "' and [x]='" & sx & "' and [y]='" & sy & "'")) Then
OutputPts = OutputPts - 1
ptXY(n) = "X"
End If
Next
Print #3, LTrim(Str(OutputPts))
For n = 1 To InputPts '此循环写入需要的点
If ptXY(n) <> "X" Then Print #3, ptXY(n)
Next
Print #3, a '写入ObjId 行
Next
Close #3
Close #1
End Sub
Function ParseN(ByRef s As String) '此函数用来截取 错误点上的每一个空格分隔值
s = LTrim(s)
sp = InStr(s, " ")
If sp = 0 Then
ParseN = s
s = ""
Else
ParseN = Left(s, sp - 1)
s = LTrim(Mid(s, sp))
End If
End Function
点击下载此附件
