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 ClassPublic 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