在AO中将数据库中数据库的表附加到SHAPE文件上

最新推荐文章于 2024-10-08 15:41:48 发布

mydriverc

最新推荐文章于 2024-10-08 15:41:48 发布

阅读量1.2k

点赞数

文章标签：数据库 string table integer layer gmail

利用关联功能来实现，代码如下，可以参考

Public Sub RelateTabletoLayer(strLayerNametoRelate As String, strTabletoRelate As String)
'************************************************************************
'The procedure relates the "res_" table to corresponding "loc_" table.
'************************************************************************
    On Error GoTo EH
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    Dim pFeatLayer As IFeatureLayer
    Dim pDispTable As IDisplayTable
    Dim pFCLayer As IFeatureClass
    Dim pTLayer As ITable
    If pMap.LayerCount = 0 Then
        MsgBox "Must have at least one layer"
        Exit Sub
    End If

    Dim pLayers As IEnumLayer
    Dim pl As ILayer
    Set pLayers = pMap.Layers
    Set pl = pLayers.Next
    While Not pl Is Nothing
        If UCase(pl.Name) = UCase(strLayerNametoRelate) Then
            Set pFeatLayer = pl
        End If
        Set pl = pLayers.Next
    Wend
    Set pDispTable = pFeatLayer
    Set pFCLayer = pDispTable.DisplayTable
    Set pTLayer = pFCLayer

    Dim pTabCollection As IStandaloneTableCollection
    Dim pStTable As IStandaloneTable
    Dim pDispTable2 As IDisplayTable
    Dim pTTable As ITable
    Dim i As Integer
    Set pTabCollection = pMap
    If pTabCollection.StandaloneTableCount = 0 Then
        MsgBox "Must have atleast one table"
        Exit Sub
    End If
    If InStr(1, strTabletoRelate, ".") Then
        strTabletoRelate = Mid(strTabletoRelate, 1, InStr(1, strTabletoRelate, ".") - 1)
    End If
    For i = 0 To pTabCollection.StandaloneTableCount - 1
        If pTabCollection.StandaloneTable(i).Name = strTabletoRelate Then
            Set pStTable = pTabCollection.StandaloneTable(i)
            Set pDispTable2 = pStTable
            Set pTTable = pDispTable2.DisplayTable
            Exit For
        End If
    Next

    Dim strJnField As String
    strJnField = "LOCID"

'   Create virtual relate

    Dim pMemRelFact As IMemoryRelationshipClassFactory
    Dim pRelClass As IRelationshipClass
    Set pMemRelFact = New MemoryRelationshipClassFactory
    Set pRelClass = pMemRelFact.Open("TabletoLayer", pTLayer, strJnField, pTTable, _
    strJnField, "forward", "backward", esriRelCardinalityOneToMany)

    ' Add it to the relates for the feature layer in Map
    Dim pRelClassCollEdit As IRelationshipClassCollectionEdit

    Set pRelClassCollEdit = pFeatLayer
    pRelClassCollEdit.AddRelationshipClass pRelClass
    '*************************************************
    '* To Show the related records uncomment this line
    '*************************************************
    ' showRelation pRelClass, pDispTable2, strQuery
    '*************************************************
    pDoc.UpdateContents
    pDoc.ActiveView.Refresh
Exit Sub
EH:
  MsgBox Err.Number & "  " & Err.Description
End Sub

Public Sub showRelation(pRelClass As IRelationshipClass, pTTable As IDisplayTable,

strWhereClause As String)
'*******************************************************************************************
'The procedure show the related records in the relation table depending on the selected

'record
'*******************************************************************************************
    Dim pQFilter As IQueryFilter
    Set pQFilter = New QueryFilter
    'pQFilter.WhereClause = "locid ='015GGR34'"
    pQFilter.WhereClause = strWhereClause
    Dim pFeatureClass As IFeatureClass
    Dim pFCursor As IFeatureCursor
    Dim pfeature As IFeature
    Dim pActiveView As IActiveView
    Dim pFeatcls As IFeatureClass
    Dim pFeatLayer As IFeatureLayer
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    Set pFeatLayer = pMap.Layer(0)
    Set pFeatureClass = pFeatLayer.FeatureClass
    Set pActiveView = pMap
    Set pFCursor = pFeatureClass.Search(pQFilter, True)
    Set pfeature = pFCursor.NextFeature
    Dim pFeatureSelection As IFeatureSelection
    Set pFeatureSelection = pFeatLayer
    pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
    pFeatureSelection.SelectFeatures pQFilter, esriSelectionResultNew, False
    pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
    Dim pDisTable As IDisplayTable
    Dim pTabSelection As ITableSelection
    Set pTabSelection = pTTable
    pTabSelection.SelectRows pQFilter, esriSelectionResultNew, False
End Sub

MSN：   gisempire@hotmail.com
QQ:      491474196(新开QQ,欢迎交流)
GMAIL:   gisempire@gmail.com
GIS的麦田守望者，希望和大家交流。
我的BLOG:http://gisempire.com/blog/user1/1/index.html