阅读:1064回复:1
关于MO的问题
MO中,如何添加Coverage?
xiexie |
|
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 |
|