Community

ArcMap Locks Up After Script Runs

627
3
01-17-2013 04:22 AM
DaleBridgford
by
New Contributor III
‎01-17-2013 04:22 AM
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
0 Kudos
3 Replies
DaleBridgford
by
New Contributor III
‎01-18-2013 11:40 AM
In the time since I initially posted, I have had the opportunity to use the script, and as many times as it will be non-responsive, it will crash.

It is an AddIn that I had migrated from 10.0, written in VB.Net 2008 (Express).  I have since rebuilt the AddIn in VB.Net 2010 (Express) with the same annoying results. 

It sounds like it shares similar issues with Mr. Salazar's post , although I have not got Service Pack 1, just straight ArcMap 10.1.

It looks like the other 7 tools I've generated in my AddIn continue to work satisfactorily, so I am at a loss.
0 Kudos
DaleBridgford
by
New Contributor III
‎01-19-2013 04:33 AM
I did regenerate the AddIn in VB.Net 2008 for ArcMap 10.0 and it had initially failed, but it was due to an error on my part (resetting a variable and subsequently calling it), which I have corrected.  At the time it failed, I submitted a crash report to ESRI with a link to this thread.  If you're here reading from the 10.0 crash, it seems to work with small selections, however, I will be testing it Tuesday with the 200,000 point dataset in both 10.0 and 10.1.

Thanks,

Dale
0 Kudos
DaleBridgford
by
New Contributor III
‎01-22-2013 06:05 AM
Well, I can't speak to 10.0 with a huge dataset, since my 10.1 AddIn won't install, but I have gotten it to run in 10.1 successfully.  Some of my issues seem to have been with the .mxd and other issues stemmed from my "superior" coding skilz.  Anyway, it works and here it is (below),

Dale

Public Class btnGlobalReplace
    Inherits ESRI.ArcGIS.Desktop.AddIns.Button
    Public Sub New()
        m_App =
        My.ArcMap.Application
    End Sub
    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. Its original purpose was to clean up "noise" in LIDAR data for groundwater modeling purposes.
        '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
        pMap = pMxDoc.FocusMap
        ' point to the active map(data frame)
        Dim pLayer As ESRI.ArcGIS.Carto.ILayer = pMxDoc.SelectedLayer
        If pLayer Is Nothing Then
            MsgBox("No layer selected!! Select one point layer from the Table of Contents")
            GoTo Clean_UP_Early
        End If
        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)
        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
        Dim txtTargetField As String = Nothing
        Dim NumFeat As Integer = pFeatureSelection.SelectionSet.Count
        Dim strReplacementValue As String = Nothing
        Dim pSelectionSet As ESRI.ArcGIS.Geodatabase.ISelectionSet = pFeatureSelection.SelectionSet
        Dim pFeatureClass As ESRI.ArcGIS.Geodatabase.IFeatureClass = pFeatureLayer.FeatureClass
        Dim pID As New ESRI.ArcGIS.esriSystem.UIDClass()
        Dim pEditor As ESRI.ArcGIS.Editor.IEditor
        'Make sure a layer has been selected
        'Acquire listing of all fields in the selected layer
        a = 0
        For a = 0 To fields.FieldCount - 1
            field = fields.Field(a)
            FieldName(a) = field.Name
            FieldType(a) = field.Type
        Next
        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_Early
SideDoor:
        txtTargetField = FieldName(i)
        Dim Value As String = ""
        Select Case FieldType(i)
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeSmallInteger
                Value = "Small Integer"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeInteger
                Value = "Long Integer"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeSingle
                Value = "Single-precision floating-point number"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeDouble
                Value = "Double-precision floating-point number"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeString
                Value = "Character string"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeDate
                Value = "Date"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeOID
                Value = "Long Integer representing an object identifier"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeGeometry
                Value = "Geometry"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeBlob
                Value = "Binary Large Object, Blob Storage"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeRaster
                Value = "Raster"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeGUID
                Value = "Globally Unique Identifier"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeGlobalID
                Value = "ESRI Global ID"
            Case ESRI.ArcGIS.Geodatabase.esriFieldType.esriFieldTypeXML
                Value = "XML Document"
        End Select
        strReplacementValue = InputBox("Please enter the value to replace the selected values in the field " & txtTargetField _
        & " of data type " & Chr(34) & Value & Chr(34) & "." _
        & vbNewLine & vbNewLine & "Be aware that entering a value of the wrong data type will crash the routine!", "Replacement Value")
        If strReplacementValue = "" Then
            MsgBox("You entered a blank value. Routine is aborting")
            GoTo Clean_Up_Early
        End If
        'Verify that a subset of the layer is selected
        If NumFeat = 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
        ' Test to see if an Edit session is open.
        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_Early
        End If
        ' Set up for the progress bar
        Dim dInterval As Double
        Dim recordCounter As Long ' measure progress
        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
        '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
        ' Get the count of features and set up the progress bar
        NumFeat = pFeatureSelection.SelectionSet.Count
        dInterval = NumFeat / 100
        pPro.MinRange = 1
        pPro.MaxRange = NumFeat
        pPro.StepValue = dInterval
        recordCounter = 0
        status_count = 0
        pPro.Position = recordCounter
        pPro.Message = "Reassigning values to " & NumFeat & " fields. (Press ESC, space bar, or mouse button to stop.)"
        pPro.Step()
        pPro.Show()
        selFeat = enumFeat.Next
        'Now loop thru all of the features 
        For recordCounter = 1 To NumFeat
            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
                    GoTo Interrupted
                Else
                    pTrackCancel.CancelOnKeyPress = True
                End If
            End If
            pPro.Position = recordCounter
            pPro.Step()
            pPro.Show()
            selFeat = enumFeat.Next
            If recordCounter = NumFeat Then GoTo Interrupted
        Next
Interrupted:
        pPro.Hide()
        If iExitStrategy = vbNo Then
            MsgBox("User Aborted mid-processing")
            pMap.FeatureSelection.Clear()
        Else : MsgBox("Finished, assigned values to " & NumFeat & " features.")
        End If
Clean_UP:
        'Clean up memory
        field = Nothing
        fields = Nothing
        a = Nothing
        bContinue = Nothing
        dInterval = Nothing
        enumFeat = Nothing
        enumFeatSet = Nothing
        FieldName = Nothing
        FieldType = Nothing
        i = Nothing
        NumFeat = Nothing
        pEditor = Nothing
        pID = Nothing
        pEditor = Nothing
        pFeatureClass = Nothing
        pFeatureLayer = 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
        pFeatureSelection.Clear()
        pMap.FeatureSelection.Clear()
        pMxDoc.ActiveView.Refresh()
Clean_Up_Early:
        pLayer = Nothing
        pMxDoc = Nothing
        pMap = Nothing
        GC.Collect()
    End Sub
    Protected Overrides Sub OnUpdate()
    End Sub
End Class
0 Kudos