bridgfod

ArcMap Locks Up After Script Runs

Discussion created by bridgfod on Jan 17, 2013
Latest reply on Jan 22, 2013 by bridgfod
Greetings,

I have written and/or assembled a VB.Net routine (VS 2010 Express) that will take a user generated selection and overwrites a field's existing values with a user-provided value.  Amazingly, it works.  However, once the routine completes and I click in the Data Frame in ArcMap 10.1, ArcMap locks up and is non-responsive.  

Apparently, I have unleashed something in the process and I don't have the programming skills to reel it in before the routine completes.  In Windows XP's Task Manager, ArcMap.exe and vbexpress.exe aren't showing huge memory usage or changes in memory, but something seems to be getting stuck somewhere.

My code is below.  Thanks in advance if anyone can see the error of my ways (not that I am using VB, please) and point it out to me.

Thanks,

Dale

  Protected Overrides Sub OnClick()

        'This routine "btnGlobalReplace" was written with the premise that the user would have a selection of features in a layer
        'that need to have a specified value placed in a specific field.  This routine will overwrite the existing value with a 
        'user specified value.  
        'Written/Assembled by Dale Bridgford 1/16/2013

        Dim pMap As ESRI.ArcGIS.Carto.IMap
        Dim pMxDoc As ESRI.ArcGIS.ArcMapUI.IMxDocument = My.ArcMap.Document
        Dim MapSpatialRef As ESRI.ArcGIS.Geometry.ISpatialReference

        Dim pLayer As ESRI.ArcGIS.Carto.ILayer = pMxDoc.SelectedLayer
        Dim pFeatureLayer As ESRI.ArcGIS.Carto.IFeatureLayer = CType(pLayer, ESRI.ArcGIS.Carto.IFeatureLayer)
        Dim pFeatureSelection As ESRI.ArcGIS.Carto.IFeatureSelection = CType(pLayer, ESRI.ArcGIS.Carto.IFeatureSelection)

        pMap = pMxDoc.FocusMap    ' point to the active map(data frame)
        MapSpatialRef = pMap.SpatialReference 'determine the data frame projection
        'Make sure a layer has been selected
        If pLayer Is Nothing Then
            MsgBox("No layer selected!! Select one point layer from the Table of Contents")
            'Exit Sub
            GoTo Clean_UP
        End If
        pFeatureLayer = pMxDoc.SelectedLayer
        'Acquire listing of all fields in the selected layer
        Dim fields As ESRI.ArcGIS.Geodatabase.IFields = pFeatureLayer.FeatureClass.Fields
        Dim field As ESRI.ArcGIS.Geodatabase.IField = Nothing
        Dim a As Integer = fields.FieldCount - 1
        Dim i As Integer = 0
        Dim FieldName(a) As String, FieldType(a) As String
        a = 0
        For a = 0 To fields.FieldCount - 1
            field = fields.Field(a)
            FieldName(a) = field.Name
            FieldType(a) = field.Type
        Next
        Dim txtTargetField As String = Nothing, txtTargetFieldType As String = Nothing
        txtTargetField = InputBox("Enter the Name of the Field to Update" & vbNewLine & "Be aware that field names are case sensitive!", "Field to Update")
        i = 0
        For i = 0 To fields.FieldCount - 1
            If FieldName(i) = txtTargetField Then GoTo SideDoor
        Next
        MsgBox("Please open the attribute table and get the correct field name.  Aborting", MsgBoxStyle.OkOnly, "Aborting")
        GoTo Clean_UP
SideDoor:
        txtTargetField = FieldName(i)
        Dim strReplacementValue As String = Nothing
        txtTargetFieldType = FieldType(i)
        strReplacementValue = InputBox("Please enter the value to replace the selected values in the field " & txtTargetField _
                                     & " of data type " & txtTargetFieldType, "Replacement Value")
        If strReplacementValue = "" Then
            MsgBox("You entered a blank value.  Routine is aborting")
            GoTo Clean_UP
        End If


        'Verify that a subset of the layer is selected
        If pFeatureSelection.SelectionSet.Count = 0 Then
            MsgBox("Aborting.  Routine needs to operate on a subset of the entire shapefile", MsgBoxStyle.Exclamation, "Select some features")
            GoTo Clean_UP
        End If
        Dim pSelectionSet As ESRI.ArcGIS.Geodatabase.ISelectionSet = pFeatureSelection.SelectionSet
        Dim pFeatureClass As ESRI.ArcGIS.Geodatabase.IFeatureClass = pFeatureLayer.FeatureClass

        ' Test to see if an Edit session is open.
        Dim pID As New ESRI.ArcGIS.esriSystem.UIDClass()
        Dim pEditor As ESRI.ArcGIS.Editor.IEditor
        pID.Value = "esriEditor.Editor"
        pEditor = m_App.FindExtensionByCLSID(pID)
        If pEditor.EditState = ESRI.ArcGIS.Editor.esriEditState.esriStateEditing Then
            MsgBox("You are in an edit session!  End your edit session and then try again.")
            GoTo Clean_UP
        End If

        ' Set up for the progress bar
        Dim lNumFeat As Long
        Dim dInterval As Double
        Dim recordCounter As Long  ' measure progress
        'Dim PauseTime, Start, Finish, TotalTime, i
        Dim status_count As Integer
        Dim psbar As ESRI.ArcGIS.esriSystem.IStatusBar
        psbar = m_App.StatusBar
        Dim pPro As ESRI.ArcGIS.esriSystem.IStepProgressor
        pPro = psbar.ProgressBar
        Dim pTrackCancel As ESRI.ArcGIS.esriSystem.ITrackCancel
        Dim bContinue As Boolean
        Dim iExitStrategy As Integer
        pTrackCancel = New ESRI.ArcGIS.Display.CancelTracker
        pTrackCancel.CancelOnKeyPress = True
        'pQF = New QueryFilter
        'pQF.WhereClause = ""
        'pFeatCursor = pFeatureClass.Search(pQF, False)
        'pFeature = pFeatCursor.NextFeature  'Select first polygon in shapefile
        'Dim pGeometry As IGeometry

        'Portion of script to begin assigning uniform value to all selected entities.
        Dim enumFeat As ESRI.ArcGIS.Geodatabase.IEnumFeature = Nothing
        Dim selFeat As ESRI.ArcGIS.Geodatabase.IFeature
        Dim enumFeatSet As ESRI.ArcGIS.Geodatabase.IEnumFeatureSetup

        enumFeat = My.ArcMap.Document.FocusMap.FeatureSelection
        enumFeatSet = enumFeat
        enumFeatSet.AllFields = True

        'Dim pGeometry As IGeometry
        ' Get the count of features and set up the progress bar
        lNumFeat = pFeatureSelection.SelectionSet.Count
        dInterval = lNumFeat / 100

        'PauseTime = 1
        pPro.MinRange = 1
        pPro.MaxRange = lNumFeat
        pPro.StepValue = dInterval
        'Now loop thru all of the features
        recordCounter = 0
        status_count = 0
        pPro.Position = recordCounter
        pPro.Message = "Reassigning values to " & lNumFeat & " fields.  (Press ESC, space bar, or mouse button to stop.)"
        pPro.Step()
        pPro.Show()


        selFeat = enumFeat.Next

        'Do While Not selFeat Is Nothing
        For recordCounter = 1 To lNumFeat
            'MsgBox(selFeat.OID)
            selFeat.Value(selFeat.Fields.FindField(txtTargetField)) = strReplacementValue
            selFeat.Store()
            bContinue = pTrackCancel.Continue
            If Not bContinue Then
                iExitStrategy = MsgBox("Calculation Interrupted!" & vbNewLine & "The Escape key, space bar, or mouse button was pressed.  Do you want to continue?", vbYesNo)
                If iExitStrategy = vbNo Then
                    'pPro.Hide()
                    GoTo Interrupted
                Else
                    pTrackCancel.CancelOnKeyPress = True
                End If
            End If

            pPro.Position = recordCounter
            pPro.Step()
            pPro.Show()
            selFeat = enumFeat.Next
            If recordCounter = lNumFeat Then GoTo Interrupted
        Next

Interrupted:
        pPro.Hide()
        If iExitStrategy = vbNo Then
            MsgBox("User Aborted mid-processing")
        Else : MsgBox("Finished")
        End If
Clean_UP:
        'Clean up memory
        pMxDoc = Nothing
        pMap = Nothing
        pLayer = Nothing
        MapSpatialRef = Nothing
        field = Nothing
        fields = Nothing
        a = Nothing
        bContinue = Nothing
        dInterval = Nothing
        enumFeat = Nothing
        enumFeatSet = Nothing
        FieldName = Nothing
        FieldType = Nothing
        i = Nothing
        lNumFeat = Nothing
        pEditor = Nothing
        pID = Nothing
        MapSpatialRef = Nothing
        pEditor = Nothing
        pFeatureClass = Nothing
        pFeatureLayer = Nothing
        pFeatureSelection.Clear() ' = Nothing
        pID = Nothing
        pLayer = Nothing
        pMap = Nothing
        pMxDoc = Nothing
        pPro = Nothing
        psbar = Nothing
        pSelectionSet = Nothing
        pTrackCancel = Nothing
        pTable = Nothing
        recordCounter = Nothing
        selFeat = Nothing
        strReplacementValue = Nothing
        GC.Collect()


    End Sub


    Protected Overrides Sub OnUpdate()

    End Sub
End Class

Outcomes