readmodel.bas

一个交通专用的gis-T系统

Attribute VB_Name = "ReadModel"
Public data() As String
Public linkplace
Public linenum


Public Sub Check(ByVal FileNameStr As String)
        
        
        
        '读取数据
        
        Dim FilePathStr
        Dim UserData
        FilePathStr = FileNameStr
        
        Dim step
        Open FilePathStr For Input As #1
        Do While Not EOF(1)
                step = step + 1
                Line Input #1, UserData
        Loop
        Close #1
        linenum = step
        

        
        ReDim data(1 To linenum)
        step = 0
        Open FilePathStr For Input As #1
        Do While Not EOF(1)
                step = step + 1
                Line Input #1, UserData
                data(step) = UserData
        Loop
        Close #1
        
        '消除前后空格
        For i = 1 To linenum
            If data(i) <> "" Then
                data(i) = Trim(data(i))
                data(i) = LTrim(data(i))
            End If
        Next i
        Frmwizard.pb2.Value = 65
        '以空格代替原tab建空格
        For i = 1 To linenum
            If InStr(data(i), vbTab) <> 0 Then
                data(i) = Replace(data(i), vbTab, " ")
            End If
        Next i
  
        For i = 1 To linenum
            If InStr(data(i), "links") <> 0 Then
                linkplace = i
            End If
        Next i
        Frmwizard.ProgressBar.Value = 10
        
        Dim SplitData
        For i = 2 To linkplace - 2

            SplitData = Split(data(i))
            
            If UBound(SplitData) < 3 Then
                MsgBox "Warning: the coordinate of node " & SplitData(1) & "  is not integrated, please check EMME/2 data!"
                Frmwizard.Command2.Visible = True
                Exit Sub
            End If
            
        Next i
        Frmwizard.pb2.Value = 100
        Frmwizard.ProgressBar.Value = 15
        
End Sub

Public Sub Readdata()


        Frmwizard.lblrun(0).FontBold = False
        Frmwizard.lblrun(1).FontBold = True
        
        Dim Rs As Recordset
        Set Rs = mDbBiblio.OpenRecordset("Nodes", dbOpenDynaset)
        Frmwizard.pb2.Value = 0
'       读节点，删除原有记录
        If Not Rs.EOF Then
            Rs.MoveFirst
        End If
        
        Do Until Rs.EOF
            Rs.Delete
            Rs.MoveNext
        Loop
        
        Frmwizard.pb2.Value = 35
        Frmwizard.ProgressBar.Value = 20
        
        Dim SplitData
        For i = 2 To linkplace - 2
        
            SplitData = Split(data(i))
          
            Rs.AddNew
            Rs("Type") = SplitData(0)
            Rs("Key") = SplitData(1)
            Rs("X") = SplitData(2)
            Rs("Y") = SplitData(3)
            Rs.Update
            
        Next i
        
        Frmwizard.pb2.Value = 65
        Frmwizard.ProgressBar.Value = 25
        
        Frmwizard.lblrun(1).FontBold = False
        Frmwizard.lblrun(2).FontBold = True
        
        '读路段，删除原有记录
        Set Rs = mDbBiblio.OpenRecordset("Links", dbOpenDynaset)
        If Not Rs.EOF Then
            Rs.MoveFirst
        End If
        Do Until Rs.EOF
            Rs.Delete
            Rs.MoveNext
        Loop
        
        For i = linkplace + 1 To linenum - 1

            SplitData = Split(data(i))
            
            Rs.AddNew
            Rs("Type") = SplitData(0)
            Rs("Stnode") = SplitData(1)
            Rs("Endnode") = SplitData(2)
            Rs("Length") = SplitData(3)
            Rs("Mode") = SplitData(4)
            Rs("NetType") = SplitData(5)
            
            Rs.Update
            
        Next i
        
        Rs.Close
        
        Frmwizard.pb2.Value = 100
        Frmwizard.ProgressBar.Value = 30
  
End Sub

Public Sub drawnetwork()

        '绘制路网
        
        
        Frmwizard.lblrun(2).FontBold = False
        Frmwizard.lblrun(3).FontBold = True
        Frmwizard.pb2.Value = 0
        
        Set Rs = mDbBiblio.OpenRecordset("nodes", dbOpenDynaset)
        Rs.MoveLast
        allnodenum = Rs("Key")
        ReDim NodesCoriX(1 To allnodenum)
        ReDim NodesCoriY(1 To allnodenum)
        
        Rs.MoveFirst
        Do Until Rs.EOF
            NodesCoriX(Rs("Key")) = Rs("X")
            NodesCoriY(Rs("Key")) = Rs("Y")
            Rs.MoveNext
        Loop
        Rs.Close
        
        Frmwizard.ProgressBar.Value = 35
        '绘制节点
        
'        Sqlsel = "Links"
'        Sqlsel = App.Path & "\Map\" & Sqlsel & ".tab"
'        Set lyr = Main.Mapshow.Layers.Add(Sqlsel)
'        Main.Mapshow.Bounds = lyr.Bounds
     
        Sqlsel = "Links"
        Sqlsel = App.Path & "\Map\" & Sqlsel & ".tab"
        Set Lyr = Main.Mapshow.Layers.Add(Sqlsel)
        Main.Mapshow.Bounds = Lyr.Bounds
            
        Dim LastOB As MapXLib.Features
        Dim lastOBF As MapXLib.Feature
        Set LastOB = Lyr.AllFeatures
        
        Dim linknum, barsep
        linknum = LastOB.Count
        
        If linknum <> 0 Then
        barsep = 50 / linknum
        End If
        
        For Each lastOBF In LastOB
            Lyr.DeleteFeature (lastOBF)
            Frmwizard.pb2.Value = Frmwizard.pb2.Value + barsep
        Next
        
        Frmwizard.ProgressBar.Value = 65
        
        
        Set Rs = mDbBiblio.OpenRecordset("links", dbOpenDynaset)
        
        linknum = linenum - linkplace
        barsep = 50 / linknum
        
        Rs.MoveFirst
        i = 0
        Dim DrawLine As MapXLib.Feature
        Dim ftr As MapXLib.Feature
        Dim ps As New Points
        Dim P As New Point
        
        '琢点绘制线路
        Do Until Rs.EOF
                
                Frmwizard.pb2.Value = Frmwizard.pb2.Value + barsep
                
                '判断点的属性，如果是形心点就不画
                Dim RsNode As Recordset
                Set RsNode = mDbBiblio.OpenRecordset("select * from Nodes where Key=" & Rs("Stnode"))
                
                If RsNode.RecordCount > 0 Then
                
                    If RsNode("Type") <> "a*" Then
                
                        ps.RemoveAll
                        
                        P.Set NodesCoriX(Rs("Stnode")), NodesCoriY(Rs("Stnode"))
                        ps.Add P
                        P.Set NodesCoriX(Rs("Endnode")), NodesCoriY(Rs("Endnode"))
                        ps.Add P
                        
                        Set ftr = Main.Mapshow.FeatureFactory.CreateLine(ps)
                        ftr.Style.LineStyle = 1
                        ftr.Style.LineWidth = 3
                        ftr.Style.LineColor = miColorBlue
                        Set DrawLine = Lyr.AddFeature(ftr)
                    
                    End If
                    
                End If
                    
                    Rs.MoveNext
                    i = i + 1
                
        Loop
        
        Main.Mapshow.Bounds = Lyr.Bounds
        Frmwizard.ProgressBar.Value = 100
        
End Sub