routeedit.bas

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

Attribute VB_Name = "CreatNetwork"
'*********************************************************************
'*
'*                本源码完全免费，共交通同仁学习参考                 *
'*                      www.tranbbs.com                              *
'*                   Developed by Yang Ming                          *
'*       Nanjing Institute of City Transportation Planning           *
'*                 请保留本版权信息，谢谢合作                        *
'*                      中国交通技术论坛                             *
'*                                                                   *
'*                                                                   *
'*********************************************************************
Option Explicit
Public Sub AddNewNode(ByVal NodeTp As String, ByVal CrossTp As Integer, ByVal CorX As Double, ByVal CorY As Double)


Dim rs As Recordset
Dim iID As Integer
Dim IMaxId As Integer
Dim f As New Feature
Dim NodeFeature As Feature
Dim LyrNode As Layer


Dim Pot As New Point

Dim RS_addnode As Recordset
Set RS_addnode = mDbBiblio.OpenRecordset("Nodes")
        
  If RS_addnode.RecordCount > 0 Then
    RS_addnode.MoveLast
    IMaxId = RS_addnode!NodeId
  End If
  
  If NodeFrm.TxtNodeId.Text <> "" Then
    iID = Val(NodeFrm.TxtNodeId.Text)
  Else
    iID = IMaxId + 1
  End If
      
  RS_addnode.AddNew
  RS_addnode!NodeId = iID
  RS_addnode!NodeX = Int(CorX)
  RS_addnode!NodeY = Int(CorY)
  RS_addnode!NodeType = NodeTp
  RS_addnode!CrossType = CrossTp
  
  If FdNum <> 0 Then
    Dim i
    For i = 1 To FdNum
        If UserName(i) = "" Then
            Dim Resp
            Resp = MsgBox("自定义字段" & NodeFrm.cmbfd.List(i - 1) & "未输入有效值，确认继续吗？选择继续将以0填充该字段！", vbOKCancel)
            If Resp = vbOK Then
                UserName(i) = 0
            Else
                Exit Sub
            End If
        End If
        RS_addnode.Fields(NodeFrm.cmbfd.List(i - 1)) = UserName(i)
    Next i
  End If
  
  RS_addnode.Update
  
  Pot.Set CorX, CorY
  Set LyrNode = Main.Mapshow.Layers("Node")
  Set f = Main.Mapshow.FeatureFactory.CreateCircularRegion(1, Pot, NodeRadius, 7, 32)

  LyrNode.Editable = True
  Set NodeFeature = LyrNode.AddFeature(f)
  NodeFeature.Style.RegionColor = miColorRed
  LyrNode.Refresh

  LyrNode.KeyField = "NodeId"
  NodeFeature.KeyValue = iID
  NodeFeature.Update
  
  
  Set RS_addnode = Nothing
  Set f = Nothing
  Set LyrNode = Nothing

End Sub


Public Function AddNewLinkFeature(iID As Long, ftrLine As Feature, iFlag As Integer)

    Dim LyrLink As Layer
    Dim LinkFtr As Feature
    
    Set LyrLink = Main.Mapshow.Layers("Link")
    LyrLink.Editable = True

    Set LinkFtr = LyrLink.AddFeature(ftrLine)
    LinkFtr.Style.LineWidth = LinkWidth
    LinkFtr.Style.LineStyle = 1
    LinkFtr.Style.LineColor = LinkColor
    LyrLink.KeyField = "LinkId"
    LinkFtr.KeyValue = iID
    LinkLength = LinkFtr.Length
    
    LinkFtr.Update
    
    LyrLink.Refresh
  
    Set LyrLink = Nothing

    
End Function



Public Sub DelFea()

    Dim Ftr1 As Feature
    Dim Ftrname As String
    Dim Lyr As Layer
   
    Set Lyr = Main.Mapshow.Layers("Node")
     For Each Ftr1 In Lyr.Selection
       Ftrname = Ftr1.KeyValue
       frmSelectionWindow.List1.AddItem "Node" & ":" & Ftrname
       frmSelectionWindow.Combo1.AddItem "Node"
       frmSelectionWindow.Combo1.Text = "Node"
     Next
    Set Lyr = Main.Mapshow.Layers("Link")
     For Each Ftr1 In Lyr.Selection
       Ftrname = Ftr1.KeyValue
       frmSelectionWindow.List1.AddItem "Link" & ":" & Ftrname
       frmSelectionWindow.Combo1.AddItem "Link"
       frmSelectionWindow.Combo1.Text = "Link"
     Next

   
End Sub