'This example demonstrates how to hook up to the Maptopology
Sub HookUpToMapTopology()
Dim bTopoExSuccessed As Boolean, pMapTopology As IMapTopology, sPath As String, pWFactory As IWorkspaceFactory
Dim pFWorkspace As IFeatureWorkspace, pfc0 As IFeatureClass, pTopologyGraph As ITopologyGraph
Dim pgdset As IGeoDataset, pTopologyExtension As ITopologyExtension, peditor As IEditor, pws As IWorkspace
Set peditor = GetEditorExtension
Set pTopologyExtension = GetTopoExtension
If pTopologyExtension Is Nothing Then Exit Sub
Set pMapTopology = pTopologyExtension.MapTopology
Set pWFactory = New ShapefileWorkspaceFactory
sPath = "D:\WorkSpace\Archives\Export_Output_2"
Set pFWorkspace = pWFactory.OpenFromFile(sPath, 0)
Set pws = pFWorkspace
Set pfc0 = pFWorkspace.OpenFeatureClass("Export_Output_4.shp")
If Not AddFeatureClassesToMap(pfc0) Then Exit Sub
If Not peditor.EditState = esriStateEditing Then peditor.StartEditing pws
pMapTopology.ClearClasses
pMapTopology.AddClass pfc0
Debug.Print pMapTopology.ClassCount
Set pTopologyGraph = pMapTopology.Cache
Set pgdset = pfc0
pTopologyGraph.Build pgdset.Extent, False
Debug.Print pTopologyGraph.Nodes.Count
'pMapTopology.ClearClasses
Dim pDocument As IDocument
Set pDocument = ThisDocument
Dim pMxDocument As IMxDocument
Set pMxDocument = pDocument
'pMxDocument.FocusMap.Layer(0).Visible = False
pMxDocument.UpdateContents
pMxDocument.ActiveView.Refresh
Dim pCommandBars As ICommandBars
Set pCommandBars = pDocument.CommandBars
Dim pUID As New UID
Dim pCmdItem As ICommandItem
' Use the CLSID of the Save command
' pUID.Value = "{DC12D55A-EC2D-4F01-8C75-B407EC0959E5}"
pUID.Value = "{7953D111-120A-4CFA-86D5-4DD93F171B55}"
' or you can use the ProgID
'pUID.Value = "esriArcMapUI.MxFileMenuItem" pUID.SubType = 3
Set pCmdItem = pCommandBars.Find(pUID)
' pCmdItem.Execute
'Dim pLayer As ILayer
'Set pLayer = pMxDocument.FocusMap.Layer(0)
'
'pLayer.Visible = False
'pMxDocument.UpdateContents
'
'pLayer.Visible = True
'pMxDocument.UpdateContents
End Sub
Private Function GetTopoExtension() As ITopologyExtension
On Error GoTo errhand
Dim pTopoEx As ITopologyExtension, pUID As UID, pApp As IApplication
Set pApp = Application
Set pUID = New UID
pUID.Value = "esriEditorExt.topologyextension"
Set pTopoEx = pApp.FindExtensionByCLSID(pUID)
Set GetTopoExtension = pTopoEx
Exit Function
errhand:
Set GetTopoExtension = Nothing
End Function
Private Function GetEditorExtension() As IEditor
On Error GoTo errhand
Dim peditor As IEditor, pUID As UID, pApp As IApplication
Set pApp = Application
Set pUID = New UID
pUID.Value = "esriEditor.editor"
Set peditor = pApp.FindExtensionByCLSID(pUID)
Set GetEditorExtension = peditor
Exit Function
errhand:
Set GetEditorExtension = Nothing
End Function
Public Function AddFeatureClassesToMap(FCArr As IFeatureClass) As Boolean
Dim pFeatureLayer As IFeatureLayer, pMap As IMap, pMxDoc As IMxDocument, pFeatureclass As IFeatureClass, i As Integer
On Error GoTo errhand
Set pFeatureclass = FCArr
Set pFeatureLayer = New FeatureLayer
Set pFeatureLayer.FeatureClass = pFeatureclass
pFeatureLayer.Name = pFeatureclass.AliasName
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
pMap.AddLayer pFeatureLayer
AddFeatureClassesToMap = True
Set pMap = Nothing
Set pMxDoc = Nothing
Set pFeatureLayer = Nothing
Set pFeatureclass = Nothing
Exit Function
errhand:
AddFeatureClassesToMap = False
Set pMap = Nothing
Set pMxDoc = Nothing
Set pFeatureLayer = Nothing
Set pFeatureclass = Nothing
End Function
記事
