添加、删除连接(Join)和关联(Relate)VBA实例
内容摘要
ArcMap里面可以通过属性字段为两个图层建立或删除连接和关联,怎样使用VBA或Engine完成同样的工作呢?
这里主要用到IDisplayRelationshipClass.DisplayRelationshipClass方法,如下为实现的VBA代码:
过程描述
Private Sub AddJoin_Relation_Click()
Dim pFeatLayer As IFeatureLayer
Dim pDispTable As IDisplayTable
Dim pFCLayer As IFeatureClass
Dim pTLayer As ITable
Dim pTabCollection As IStandaloneTableCollection
Dim pStTable As IStandaloneTable
Dim pDispTable2 As IDisplayTable
Dim pTTable As ITable
Dim pMemRelFact As IMemoryRelationshipClassFactory
Dim pRelClass As IRelationshipClass
Dim pDispRC As IDisplayRelationshipClass
Set pFeatLayer = GetLayer(0) ' MapControl1.Layer(0)
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.ActiveView
Set pTabCollection = pMap
If pTabCollection.StandaloneTableCount = 0 Then
Exit Sub
End If
Set pDispTable = pFeatLayer
Set pFCLayer = pDispTable.DisplayTable
Set pTLayer = pFCLayer
Set pDispRC = pFeatLayer
Set pStTable = pTabCollection.StandaloneTable(0)
Set pDispTable2 = pStTable
Set pTTable = pDispTable2.DisplayTable
Set pMemRelFact = New MemoryRelationshipClassFactory
Set pRelClass = pMemRelFact.Open(pStTable.Name, pTTable, "id", pTLayer, "省行政中心", "forward", "backward", esriRelCardinality.esriRelCardinalityOneToMany) '这里参数根据具体数据和需求设置,详细信息可参照开发帮助文档
'增加连接Join
pDispRC.DisplayRelationshipClass pRelClass, esriJoinType.esriLeftOuterJoin
'增加关系 --Relate
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pFeatLayer
pRelClassCollEdit.AddRelationshipClass pRelClass
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "建立关联时:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
End Sub
'删除连接和关联
Private Sub RemoveJoinRelation_Click()
Dim pFeatLayer As IFeatureLayer
Dim pDispRC As IDisplayRelationshipClass
Dim pRelationshipClassCollectionEdit As IRelationshipClassCollectionEdit
Set pFeatLayer = GetLayer(0) ' MapControl1.Layer(0)
Set pRelationshipClassCollectionEdit = pFeatLayer
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "删除关联前:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
'删除Relate
Call pRelationshipClassCollectionEdit.RemoveAllRelationshipClasses
'删除所有Join
pDispRC.DisplayRelationshipClass Nothing, esriJoinType.esriLeftOuterJoin '这里第一个参数传入Nothing即可完成删除
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "删除关联后:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
ArcMap里面可以通过属性字段为两个图层建立或删除连接和关联,怎样使用VBA或Engine完成同样的工作呢?
这里主要用到IDisplayRelationshipClass.DisplayRelationshipClass方法,如下为实现的VBA代码:
过程描述
Private Sub AddJoin_Relation_Click()
Dim pFeatLayer As IFeatureLayer
Dim pDispTable As IDisplayTable
Dim pFCLayer As IFeatureClass
Dim pTLayer As ITable
Dim pTabCollection As IStandaloneTableCollection
Dim pStTable As IStandaloneTable
Dim pDispTable2 As IDisplayTable
Dim pTTable As ITable
Dim pMemRelFact As IMemoryRelationshipClassFactory
Dim pRelClass As IRelationshipClass
Dim pDispRC As IDisplayRelationshipClass
Set pFeatLayer = GetLayer(0) ' MapControl1.Layer(0)
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.ActiveView
Set pTabCollection = pMap
If pTabCollection.StandaloneTableCount = 0 Then
Exit Sub
End If
Set pDispTable = pFeatLayer
Set pFCLayer = pDispTable.DisplayTable
Set pTLayer = pFCLayer
Set pDispRC = pFeatLayer
Set pStTable = pTabCollection.StandaloneTable(0)
Set pDispTable2 = pStTable
Set pTTable = pDispTable2.DisplayTable
Set pMemRelFact = New MemoryRelationshipClassFactory
Set pRelClass = pMemRelFact.Open(pStTable.Name, pTTable, "id", pTLayer, "省行政中心", "forward", "backward", esriRelCardinality.esriRelCardinalityOneToMany) '这里参数根据具体数据和需求设置,详细信息可参照开发帮助文档
'增加连接Join
pDispRC.DisplayRelationshipClass pRelClass, esriJoinType.esriLeftOuterJoin
'增加关系 --Relate
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pFeatLayer
pRelClassCollEdit.AddRelationshipClass pRelClass
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "建立关联时:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
End Sub
'删除连接和关联
Private Sub RemoveJoinRelation_Click()
Dim pFeatLayer As IFeatureLayer
Dim pDispRC As IDisplayRelationshipClass
Dim pRelationshipClassCollectionEdit As IRelationshipClassCollectionEdit
Set pFeatLayer = GetLayer(0) ' MapControl1.Layer(0)
Set pRelationshipClassCollectionEdit = pFeatLayer
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "删除关联前:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
'删除Relate
Call pRelationshipClassCollectionEdit.RemoveAllRelationshipClasses
'删除所有Join
pDispRC.DisplayRelationshipClass Nothing, esriJoinType.esriLeftOuterJoin '这里第一个参数传入Nothing即可完成删除
Set pDispRC = pFeatLayer
If Not pDispRC.RelationshipClass Is Nothing Then
MsgBox "删除关联后:" & pDispRC.RelationshipClass.OriginClass.AliasName
End If
End Sub
关联后的表,查询时可以使用 IDisplayFeatureClass来查询
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFClass As IFeatureClass
pFClass = pGeoFeatureLayer.DisplayFeatureClass
pFeatureCursor = pFClass.Search(Nothing, False)