zyj_iim
路人甲
路人甲
  • 注册日期2003-12-06
  • 发帖数137
  • QQ
  • 铜币264枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1064回复:1

关于MO的问题

楼主#
更多 发布于:2003-12-08 15:49
MO中,如何添加Coverage?

xiexie
喜欢0 评分0
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
1楼#
发布于:2003-12-08 16:23
Private Sub addCoverage(BasePath As String, Filename As String)
  Dim dCon As New DataConnection
  Dim gSet As GeoDataset
  Dim str As String
  Dim textPos As Long, periodPos As Long
  Dim test As Boolean
  Dim tempChar As String
  Dim fullfile As String, workspace As String, featAttTable As String
  
  fullfile = Trim$(Filename)

  textPos = Len(BasePath)
  test = False
  Do While test = False
    textPos = textPos - 1
    tempChar = Mid$(BasePath, textPos, 1)
    If tempChar = "." Then
      periodPos = textPos
    ElseIf tempChar = "\" Or textPos = 0 Then
      test = True
    End If
  Loop
  
  workspace = "[arc]" & Left$(BasePath, textPos - 1)
  
  Dim coverage As String
  Dim lenBasePath As Long
  Dim ext As String
  ext = LCase(Right$(Filename, 3))
  lenBasePath = Len(BasePath)
  coverage = Right$(BasePath, lenBasePath - textPos)
  
  If ext = "adf" Then
    featAttTable = coverage & "." & Left$(Filename, Len(Filename) - 4)
  Else
    featAttTable = coverage & "." & ext & Left$(Filename, Len(Filename) - 4)
  End If
    
  featAttTable = LCase(featAttTable)
  workspace = LCase(workspace)
  
  dCon.Database = workspace
  If dCon.Connect Then
    Set gSet = dCon.FindGeoDataset(featAttTable)
    If gSet Is Nothing Then
      MsgBox "Error opening coverage feature attribute table " & featAttTable
      Exit Sub
    Else
      Dim newLayer As New MapLayer
      newLayer.GeoDataset = gSet
      newLayer.Name = featAttTable
      '
      Dim i As Integer
      For i = 0 To frmMain.Map1.Layers.Count - 1
        If newLayer.Name = frmMain.Map1.Layers(i).Name Then
          MsgBox ("已有名称为" & newLayer.Name & "的图层,系统自动对其进行重命名,建议您最好自己再对其进行重命名。")
          newLayer.Name = newLayer.Name & "1"
        Else
          
        End If
      Next
      
      AddLayerToTail newLayer
    End If
  Else
    MsgBox ConnectErrorMsg(dCon.ConnectError), vbCritical, "Connection error"
  End If

End Sub
举报 回复(0) 喜欢(0)     评分
游客

返回顶部