Paste the following into the code module.
Public Sub CreateDangleElements()
On Error GoTo eH
'Get the editor extension
Dim pEditor As IEditor
Dim pID As New UID
pID.Value = "esriCore.Editor"
Set pEditor = Application.FindExtensionByCLSID(pID)
'Make sure you are editing
If Not pEditor.EditState = esriStateEditing Then Exit Sub
'Coverage workspace only
If Not TypeOf pEditor.EditWorkspace Is IArcInfoWorkspace Then Exit Sub
'Get the target layer
Dim pEditLayers As IEditLayers
Dim pTarget As IFeatureLayer
Set pEditLayers = pEditor
Set pTarget = pEditLayers.CurrentLayer
'Make sure it is a coverage arc featureclass
If Not TypeOf pTarget.FeatureClass Is ICoverageFeatureClass Then Exit Sub
Dim pCovClass As ICoverageFeatureClass
Set pCovClass = pTarget.FeatureClass
'Make sure the target is an arc feature class
If Not pCovClass.FeatureClassType = esriCFCTArc Then Exit Sub
'Need the full coverage path as a string for the node errors command
Dim sCoverageName As String
sCoverageName = pTarget.FeatureClass.FeatureDataset.Workspace.PathName _
& "\" & pTarget.FeatureClass.FeatureDataset.Name
'Use the ARC ODE component and run the NODEERRORS command
Dim pArc As New ESRI.Arc
Dim pResults As New ESRIutil.Strings
Dim lSev As Long
lSev = pArc.Command("nodeerrors " & sCoverageName & " dangles fullreport", pResults)
Dim i As Integer
If Not pResults.Count > 2 Then
MsgBox "No Dangles Found.", vbInformation
Exit Sub
End If
'Get the graphics container
Dim pAv As IActiveView, pGC As IGraphicsContainer
Set pAv = pEditor.Map
Set pGC = pAv.GraphicsContainer
'Set up Status bar objects
Dim lNum As Long
Dim dInt As Double
Dim pSbar As IStatusBar, pPro As IStepProgressor
Dim Start, Finish, TotalTime
lNum = pResults.Count - 1
dInt = lNum / 100
Set pSbar = Application.StatusBar
Set pPro = pSbar.ProgressBar
pPro.MinRange = 1
pPro.MaxRange = lNum
pPro.StepValue = dInt
Dim pPt As IPoint
Dim pElem As IElement
'Loop through the strings results collection and pull out the coordinates
'then create a new point geometry and add that point as a marker element
'to the map
For i = 0 To pResults.Count - 2
Dim sBefore As String, sAfter As String, sCoord As String
sAfter = After(pResults.Item(i), "(")
sBefore = Before(sAfter, ")")
sCoord = sBefore
If Not IsNumeric(Before(sCoord, ",")) Then Exit For
Dim dX As Double, dY As Double
dX = CDbl(Before(sCoord, ","))
dY = CDbl(After(sCoord, ","))
Set pPt = New esriCore.Point
pPt.PutCoords dX, dY
Set pElem = New MarkerElement
pElem.Geometry = pPt
pGC.AddElement pElem, 0
pPro.position = i
pPro.Message = "Adding Elements..."
pPro.Step
Set pElem = Nothing
Set pPt = Nothing
Next i
pPro.Hide
pAv.Refresh
Set pResults = Nothing
Set pArc = Nothing
Set pAv = Nothing
Set pGC = Nothing
Set pPt = Nothing
Set pElem = Nothing
Exit Sub
eH:
MsgBox "CreateDangleElements failed: " & Err.Description
End Sub
Public Sub CreatePseudoElements()
On Error GoTo eH
'Get the editor extension
Dim pEditor As IEditor
Dim pID As New UID
pID.Value = "esriCore.Editor"
Set pEditor = Application.FindExtensionByCLSID(pID)
'Make sure you are editing
If Not pEditor.EditState = esriStateEditing Then Exit Sub
'Coverage workspace only
If Not TypeOf pEditor.EditWorkspace Is IArcInfoWorkspace Then Exit Sub
'Get the target layer
Dim pEditLayers As IEditLayers
Dim pTarget As IFeatureLayer
Set pEditLayers = pEditor
Set pTarget = pEditLayers.CurrentLayer
'Make sure it is a coverage arc featureclass
If Not TypeOf pTarget.FeatureClass Is ICoverageFeatureClass Then Exit Sub
Dim pCovClass As ICoverageFeatureClass
Set pCovClass = pTarget.FeatureClass
'Make sure the target is an arc feature class
If Not pCovClass.FeatureClassType = esriCFCTArc Then Exit Sub
'Need the full coverage path as a string for the node errors command
Dim sCoverageName As String
sCoverageName = pTarget.FeatureClass.FeatureDataset.Workspace.PathName _
& "\" & pTarget.FeatureClass.FeatureDataset.Name
'Use the ARC ODE component and run the NODEERRORS command
Dim pArc As New ESRI.Arc
Dim pResults As New ESRIutil.Strings
Dim lSev As Long
lSev = pArc.Command("nodeerrors " & sCoverageName & " pseudos fullreport", pResults)
Dim i As Integer
If Not pResults.Count > 1 Then
MsgBox "No Pseudos Found.", vbInformation
Exit Sub
End If
'Get the graphics container
Dim pAv As IActiveView, pGC As IGraphicsContainer
Set pAv = pEditor.Map
Set pGC = pAv.GraphicsContainer
'Set up Status bar objects
Dim lNum As Long
Dim dInt As Double
Dim pSbar As IStatusBar, pPro As IStepProgressor
Dim Start, Finish, TotalTime
lNum = pResults.Count - 1
dInt = lNum / 100
Set pSbar = Application.StatusBar
Set pPro = pSbar.ProgressBar
pPro.MinRange = 1
pPro.MaxRange = lNum
pPro.StepValue = dInt
Dim pPt As IPoint
Dim pElem As IElement
'Loop through the strings results collection and pull out the coordinates
'then create a new point geometry and add that point as a marker element
'to the map
For i = 0 To pResults.Count - 1
Dim sBefore As String, sAfter As String, sCoord As String
sAfter = After(pResults.Item(i), "(")
sBefore = Before(sAfter, ")")
sCoord = sBefore
If Not IsNumeric(Before(sCoord, ",")) Then Exit For
Dim dX As Double, dY As Double
dX = CDbl(Before(sCoord, ","))
dY = CDbl(After(sCoord, ","))
Set pPt = New esriCore.Point
pPt.PutCoords dX, dY
Set pElem = New MarkerElement
Dim pMarkerElem As IMarkerElement
Set pMarkerElem = pElem
Dim pSimpleMark As ISimpleMarkerSymbol
Set pSimpleMark = New esriCore.SimpleMarkerSymbol
Dim pRgb As IRgbColor
Set pRgb = New esriCore.RgbColor
pRgb.Blue = 255
pRgb.Red = 0
pRgb.Green = 0
pSimpleMark.Color = pRgb
pSimpleMark.Style = esriSMSDiamond
pMarkerElem.Symbol = pSimpleMark
pElem.Geometry = pPt
pGC.AddElement pElem, 0
pPro.position = i
pPro.Message = "Adding Elements..."
If Not pPro.MaxRange = i + 1 Then
pPro.Step
End If
Set pElem = Nothing
Set pPt = Nothing
Next i
pPro.Hide
pAv.Refresh
Set pResults = Nothing
Set pArc = Nothing
Set pAv = Nothing
Set pGC = Nothing
Set pPt = Nothing
Set pElem = Nothing
Exit Sub
eH:
MsgBox "CreateDangleElements failed: " & Err.Description
End Sub
Private Function Before(Str As String, SearchStr As String) As String
' Returns the substring of Str to the left of the leftmost
' occurrence of the searchStr.
Dim position As Integer
Dim length As Integer
position = InStr(Str, SearchStr)
length = Len(SearchStr)
If Not (position = 0) Then
Before = Mid(Str, 1, position - 1)
End If
End Function
Private Function After(Str As String, SearchStr As String) As String
' Returns the substring of Str to the right of the leftmost
' occurrence of the searchStr.
Dim position As Integer
Dim length As Integer
position = InStr(Str, SearchStr)
length = Len(SearchStr)
If Not (position = 0) Then
After = Mid(Str, position + length)
End If
End Function