ArcObjects Library Reference  (SystemUI)    

IOperation Example

[Visual Basic 6.0]
'This Example shows two pieces.  First is a Apply_Click Sub that is the
'Click event for a button called Apply in a form.  The rest is the ssOp
'Class, which implements IOperation and contains the code that will
'be executed, first on this click event, and then other code that will be
'run for undo and redo operations. 
 
Public Sub Apply_Click()
    '***
    '*** Important--This code run out of the
    '*** SelSimOperation::Do method.
    '***
    Dim ssOp As IOperation
    Set ssOp = New SelSimOperation
    m_pMxDoc.OperationStack.Do ssOp
End Sub
'***************** Class ssOp****************
Option Explicit
Implements IOperation
Public affectsLayer As IFeatureLayer
Public startSelSet As ISelectionSet
Public resultSelSet As ISelectionSet
Private mxMap As IMap
Private mxDoc As IMxDocument
Private Property Get IOperation_CanRedo() As Boolean
    IOperation_CanRedo = True
End Property
Private Property Get IOperation_CanUndo() As Boolean
    IOperation_CanUndo = True
End Property
Public Sub IOperation_Do()
    'For every numeric field that's checked, get the min and max
    'then determine percentage range and assemble a WHERE clause
    'For every string field that's checked assemble a WHERE clause
    'to include that variable.
    'This function is called from the Apply button's Click Event in the form: SelSimExprDlg
    
    SelStuff.SelSim.MousePointer = 11
    Dim gfID As New UID
    Dim gfLyrs As IEnumLayer
    gfID = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'IGeoFeatureLayer
    Set gfLyrs = SelStuff.SelSim.m_pfMap.Layers(gfID, True)
    Set mxMap = SelStuff.SelSim.m_pfMap
    Set mxDoc = SelStuff.SelSim.m_pMxDoc
    gfLyrs.Reset
    Dim pfeaLyr As IFeatureLayer
    Dim pFlds As IFields
    Set pfeaLyr = gfLyrs.Next
    Dim k As String
    k = pfeaLyr.Name
    Dim kn As String
    kn = SelSim.Layers.List(SelStuff.SelSim.Layers.ListIndex)
    If kn = "" Then
        kn = SelStuff.SelSim.Layers.List(0)
    End If
    Dim pflyrName As String
    pflyrName = pfeaLyr.Name
    While Not pflyrName = kn
        Set pfeaLyr = gfLyrs.Next
        pflyrName = pfeaLyr.Name
    Wend
    Dim pQFilt As IQueryFilter
    Dim pCurs As ICursor
    Dim pFCurs As IFeatureCursor
    Dim pFSel As IFeatureSelection
    Dim pSelSet As ISelectionSet
        
    Set pFSel = pfeaLyr
    Set pSelSet = pFSel.SelectionSet
    Set pQFilt = New QueryFilter
    pSelSet.Search pQFilt, False, pCurs
    Set pFCurs = pCurs
    '** Support UNDO/REDO
    Set affectsLayer = pfeaLyr
    Set startSelSet = pSelSet
    
    Dim StrWhr As String
    StrWhr = ""
    Dim WhrPair
    Set WhrPair = CreateObject("Scripting.Dictionary")
    Set pFlds = pfeaLyr.FeatureClass.Fields
 
    'SValsInc = 0
    If SelStuff.SelSim.StrFlds.SelCount > 0 Then
        Dim SC As Integer
        Dim SCC As Long
        Dim pFeat As IFeature
        SC = SelStuff.SelSim.StrFlds.ListCount
        
        '** Loop through the string field list
        Dim WithinField As Boolean
        WithinField = False
      
        For SCC = 0 To (SC - 1)
            WithinField = False
            '** IF the field is selected then created an entry in the WhereClause
            WhrPair.RemoveAll
            If SelSim.StrFlds.Selected(SCC) Then
                '** Figure out a list of unique features
                Set pFeat = pFCurs.NextFeature
                Dim kx As String
                
                While Not pFeat Is Nothing
                    kx = pFeat.Value(pFlds.FindField(SelSim.StrFlds.List(SCC)))
                    '** Check to see if the value is already in the list, If not add it.
                    If Not WhrPair.Exists(kx) Then
                        WhrPair.Add kx, SelSim.StrFlds.List(SCC)
                        If StrWhr = "" Then
                            StrWhr = "[" & SelStuff.SelSim.StrFlds.List(SCC) & "] = '" & kx & "'"
                            WithinField = True
                        Else
                            If WithinField Then
                                StrWhr = StrWhr & " OR [" & SelStuff.SelSim.StrFlds.List(SCC) & "] = '" & kx & "'"
                            Else
                                StrWhr = StrWhr & " AND [" & SelStuff.SelSim.StrFlds.List(SCC) & "] = '" & kx & "'"
                                WithinField = True
                            End If
                        End If
                    End If
                    Set pFeat = pFCurs.NextFeature
                Wend
            End If
            pSelSet.Search pQFilt, False, pCurs
            Set pFCurs = pCurs
        Next SCC
        WithinField = False
    End If 'If StrFlds.SelCount > 0
    
    If SelStuff.SelSim.NumFlds.SelCount > 0 Then
        '** Do Numbers
        Dim NCC As Integer
        For NCC = 0 To SelStuff.SelSim.NumFlds.ListCount - 1  'For each field in the field list
            WithinField = False
            If SelStuff.SelSim.NumFlds.Selected(NCC) Then 'If the NCCth field is selected
                Set pFeat = pFCurs.NextFeature
                If SelStuff.SelSim.NumVar.SelText = "0" Then
                    Dim ky As Variant
                    WhrPair.RemoveAll
                    While Not pFeat Is Nothing
                        ky = pFeat.Value(pFlds.FindField(SelStuff.SelSim.NumFlds.List(NCC)))
                        If Not WhrPair.Exists(ky) Then
                            WhrPair.Add ky, SelStuff.SelSim.NumFlds.List(NCC)
                            If StrWhr = "" Then
                                StrWhr = "[" & SelStuff.SelSim.NumFlds.List(NCC) & "] = " & ky
                                WithinField = True
                            Else
                                If WithinField Then
                                   StrWhr = StrWhr & " OR [" & SelStuff.SelSim.NumFlds.List(NCC) & "] = " & ky
                                Else
                                    StrWhr = StrWhr & " AND [" & SelStuff.SelSim.NumFlds.List(NCC) & "] = " & ky
                                    WithinField = True
                                End If
                            End If
                        End If
                        Set pFeat = pFCurs.NextFeature
                    Wend
                Else 'SelSim.NumVar.SelTExt <> "0", i.e., we have a tolerance
                    Dim kmin As Variant
                    Dim kmax As Variant
                    Dim kcur As Variant
                    If Not pFeat Is Nothing Then
                        kmin = pFeat.Value(pFlds.FindField(SelStuff.SelSim.NumFlds.List(NCC)))
                        kmax = kmin
                        Set pFeat = pFCurs.NextFeature
                    End If
                    While Not pFeat Is Nothing
                        kcur = pFeat.Value(pFlds.FindField(SelStuff.SelSim.NumFlds.List(NCC)))
                        If kcur < kmin Then
                            kmin = kcur
                        End If
                        If kcur > kmax Then
                            kmax = kcur
                        End If
                        Set pFeat = pFCurs.NextFeature
                    Wend
                    Dim pval As Integer
                    Dim pvar As Double
                    Dim psel As String
                    psel = SelSim.NumVar.Text
                    If psel = "" Then
                        psel = "3"
                    End If
                    pval = Val(psel)
                    If kmax = kmin Then
                        pvar = kmax / 100 * pval
                    Else
                        pvar = (kmax - kmin) / 100 * pval
                    End If
                    If StrWhr = "" Then
                        StrWhr = "[" & SelStuff.SelSim.NumFlds.List(NCC) & "] >= " & (kmin - pvar) _
                        & " AND [" & SelStuff.SelSim.NumFlds.List(NCC) & "] <= " & (kmax + pvar)
                        WithinField = True
                    Else
                        If WithinField Then
                            StrWhr = StrWhr & " OR [" & SelStuff.SelSim.NumFlds.List(NCC) & "] >= " & (kmin - pvar) _
                            & " AND [" & SelStuff.SelSim.NumFlds.List(NCC) & "] <= " & (kmax + pvar)
                        Else
                            StrWhr = StrWhr & " AND [" & SelStuff.SelSim.NumFlds.List(NCC) & "] >= " & (kmin - pvar) _
                            & " AND [" & SelStuff.SelSim.NumFlds.List(NCC) & "] <= " & (kmax + pvar)
                            WithinField = True
                        End If
                    End If
                End If
            End If
            pSelSet.Search pQFilt, False, pCurs
            Set pFCurs = pCurs
            WithinField = False
        Next NCC
    End If
    If SelStuff.SelSim.ShowQuery.Value Then
        SelStuff.SelSimExprDlg.ExprText.Text = StrWhr
        SelStuff.SelSimExprDlg.Label1.Caption = StrWhr
        SelStuff.SelSimExprDlg.Show vbModal, SelStuff.SelSim
        If SelStuff.SelSimExprDlg.Label1.Caption = "Cancel" Then
            SelStuff.SelSim.MousePointer = 0
            Exit Sub
        End If
        StrWhr = SelStuff.SelSimExprDlg.ExprText.Text
    End If
    'Need to Substitute "[" and "]" with
    'Chr(34) for dBase (Shapefiles}
    'Chr(34) for Coverage
    'Nothing for PGdb
    If pfeaLyr.FeatureClass.FeatureClassID = -1 Then
        StrWhr = ReplaceString(StrWhr, "[", Chr(34))
        StrWhr = ReplaceString(StrWhr, "]", Chr(34))
    End If
    Dim SimFilt As IQueryFilter
    Set SimFilt = New QueryFilter
    SimFilt.WhereClause = StrWhr
    pFSel.SelectFeatures SimFilt, esriSelectionResultNew, False
    
'** THIS IS REALLY IMPORTANT FOR THIS EXAMPLE
    '** Support Undo/Redo
    Set resultSelSet = pFSel.SelectionSet
    SelStuff.SelSim.MousePointer = 0
    SelStuff.SelSim.Hide
    SelStuff.SelSim.m_pMxDoc.ActiveView.Refresh
    SelStuff.SelSim.m_pMxDoc.UpdateContents
    SelStuff.SelSimAdv.InitStatus.Caption = "Clean"
    Unload SelSim 'Unloading this messes up Undo/Redo!!
    
End Sub
Private Property Get IOperation_MenuString() As String
    IOperation_MenuString = "Select Similar"
End Property
Private Sub IOperation_Redo()
    '** Here we store an ISelection Set object (the one that
    '** results from IOperation_Do) and a pointer to the layer
    '** it applies to
    
    Dim rFSel As IFeatureSelection
    Set rFSel = affectsLayer 'QI
    Set rFSel.SelectionSet = resultSelSet
    mxDoc.ActiveView.Refresh
    mxDoc.UpdateContents
    
End Sub
Private Sub IOperation_Undo()
    '* Here we store an ISelectionSet Object and
    '* a pointer to the layer we want to apply it to.
    'On Error GoTo foo
    
    Dim uFSel As IFeatureSelection
    Set uFSel = affectsLayer 'QI
    Set uFSel.SelectionSet = startSelSet
    mxDoc.ActiveView.Refresh
    mxDoc.UpdateContents
    Exit Sub
'foo:
    'MsgBox "Error. " & Err.Number & ": " & Err.Description
End Sub
Private Function ReplaceString(ByVal qtxt As String, ByVal from_str As String, ByVal to_str As String)
    Dim new_txt As String
    Dim pos As Integer
    Do While Len(qtxt) > 0
        pos = InStr(qtxt, from_str)
        If pos = 0 Then
            ' No more occurrences.
            new_txt = new_txt & qtxt
            qtxt = ""
        Else
            ' Found it.
            new_txt = new_txt & Left$(qtxt, pos - 1) & to_str
            qtxt = Mid$(qtxt, pos + Len(from_str))
        End If
    Loop
    ReplaceString = new_txt
End Function

[Visual Basic .NET, C#, C++]
No example is available for Visual Basic .NET, C#, or C++. To view a Visual Basic 6.0 example, click the Language Filter button Language Filter in the upper-left corner of the page.