Select to view content in your preferred language

confusing query filter

2837
14
11-05-2010 07:14 AM
Cut_EliaRahmi
Emerging Contributor
Dear all
I'm trying to learn th code below and compare with mine. I use vba,  but I get confusing in part of query. What is the code that appropriate for me to change "StateId"? Thanks a lot for everyone who help

Example:
Public Sub ZoomToState(StateId As String)
....
....
Dim pQueryFilter As IQueryFilter
Dim queryStr As String
  
queryStr = "Land_Unit='" & StateId & "'"
Set pActView = pMxDoc.activeView
Set pQueryFilter = New queryFilter
pQueryFilter.WhereClause = queryStr
Set pFCursor = pFClass.Search(pQueryFilter, True)

....
....

End Sub

My code for query:
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If cboKabupaten.Visible = True Then
    pQueryFilter.WhereClause = "Land_Unit = '" & cboSatuanLahan.Text & "' And KABUPATEN = '" & cboKabupaten.Text & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & cboSatuanLahan.Text & "'"
End If
0 Kudos
14 Replies
RichardFairhurst
MVP Alum
Your code looks basically fine to me provided that your field name is actually Land_Unit.  Does it not get the result you want?  Potentially you want to have code that validates that a choice has been made in the comboboxes prior to letting this code fire.  I would test that the values are greater than " ".
0 Kudos
Cut_EliaRahmi
Emerging Contributor
Hi Richard,
Thanks for answering. I�??m trying to modify the code that I got from a book to zoom feature.
Here is the code:
Public Sub ZoomToState(StateId As String)

    Set pMxDoc = ThisDocument
    Set pFLayer = pMxDoc.FocusMap.Layer(0)
    Set pFClass = pFLayer.FeatureClass
   
    Dim pEnv As IEnvelope
    Dim pActView As IActiveView
    Dim pFCursor As IFeatureCursor
    Dim pQFilt As IQueryFilter
    Dim queryStr As String
   
    queryStr = "STATE_NAME='" & StateId & "'"
    Set pActView = pMxDoc.ActiveView
    Set pQFilt = New QueryFilter
    pQFilt.WhereClause = queryStr
    Set pFCursor = pFClass.Search(pQFilt, True)
    Set pFeature = pFCursor.NextFeature
        If pFeature Is Nothing Then
            MsgBox "Check spelling and case", vbCritical + vbExclamation, "State Not Found!"
        Else
            pActView.Extent = pFeature.Shape.Envelope
            Set pEnv = pActView.Extent
            pEnv.Expand 1.1, 1.1, True
            pActView.Extent = pEnv
        End If
       
    Dim flDef As IFeatureLayerDefinition
    Set flDef = pFLayer
    flDef.DefinitionExpression = "STATE_NAME='" & StateId & "'"
       
    pActView.Refresh
    pMxDoc.UpdateContents
   

End Sub

If I change STATE_NAME to my field name i.e Land_Unit,  StateId to LandUnitId, the result is it only zoom to one feature, whereas some LandUnitId has more than one features (it doen�??t zoom to all selected features). I also need to change in part of query, because sometimes I need to query by using AND. This is what I�??m doing now. At the end, I will cut them such as query by attribute in arcmap (not done yet).

Below is my code that still error, my guess is I don�??t write code like �??StadeId As String�?� in the procedure, that�??s why my 1st post asked about that.

Private Sub cmdNewLayer_Click()
    Call ZoomTasks.ZoomToLandUnit(cboSatuanLahan.Value)    �??here is error: wrong number of arguments or invalid property assignment
End Sub

Private Sub UserForm_Initialize()
Dim strFile1 As String
    strFile1 = "D:\AMIE\BELAJAR\Belajar ArcObjects\LandUnit.txt"
   
Dim strLandUnit As String
   
Open strFile1 For Input As #1
   
Do Until EOF(1)
    Input #1, strLandUnit
    cboSatuanLahan.AddItem strLandUnit
Loop
   
Close #1
cboSatuanLahan.Value = "-Land Unit-"
   
Dim strFile2 As String
    strFile2 = "D:\AMIE\BELAJAR\Belajar ArcObjects\Kabupaten.txt"

Dim strKabupaten As String

Open strFile2 For Input As #2

Do Until EOF(2)
    Input #2, strKabupaten
    cboKabupaten.AddItem strKabupaten
Loop

Close #2
cboKabupaten.Value = "-Kabupaten-"
   
End Sub

Public Sub ZoomToLandUnit()

Dim pDocument As IMxDocument
Set pDocument = ThisDocument
Dim pMap As IMap
Set pMap = pDocument.FocusMap
Dim pFeatLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Sub

'set up the selection
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pLayer
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If cboKabupaten.Visible = True Then
    pQueryFilter.WhereClause = "Land_Unit = '" & cboSatuanLahan.Text & "' And KABUPATEN = '" & cboKabupaten.Text & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & cboSatuanLahan.Text & "'"
End If

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

'access the feature
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pFeatSelection.selectionSet

Dim pDataset As IDataset
Set pDataset = pFeatClass

Set pFeatLayer = pLayer
Set pFeatClass = pFeatLayer.FeatureClass

If pSelectionSet.Count = 0 Then
    MsgBox " The expression was verified successfully, but no records were returned", vbInformation
    Unload Me
    Exit Sub
End If

Dim pFeatCursor As IFeatureCursor
pSelectionSet.Search Nothing, False, pFeatCursor
Dim pFeature As IFeature
Set pFeature = pFeatCursor.NextFeature()

'zoom to all features
Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind

Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelectionSet

Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment

Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)

Dim pFeatLayerDef As IFeatureLayerDefinition
Set pFeatLayerDef = pLayer
If cboKabupaten.Visible = True Then
    pFeatLayerDef.DefinitionExpression = "Land_Unit = '" & cboSatuanLahan.Text & "' And KABUPATEN = '" & cboKabupaten.Text & "'"
Else
    pFeatLayerDef.DefinitionExpression = "Land_Unit = " & "'" & cboSatuanLahan.Text & "'"
End If

'update the extent of the map to match the extent of the feature
Dim pActiveView As IActiveView
Set pActiveView = pMap
pActiveView.Extent = pGeom.Envelope
pActiveView.Refresh

Dim pFeatDef As IFeatureLayerDefinition
Set pFeatDef = pFeatLayer

Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(Soil, True, "", "")

pActiveView.Refresh
pDocument.UpdateContents

End Sub

Thanks Richard, I hope you can help me to find the mistake of what I�??ve wrote. I�??m looking forward to hearing from you.

Regards,

Amie
0 Kudos
RichardFairhurst
MVP Alum
You are correct that either you need to include an argument of some variable that is a string in your ZoomToLandUnit Sub declaration or you need to remove it from the calling declaration.  Currently the two do not match.  If your ZoomToLandUnit can access the form combobox values directly from the Form without being given them as arguments, then you don't really need the arguments.  If the Subroutine needs to work outside of the Form, then you need to supply the combobox values through the arguments.

If you use argument variables in the Sub declaration definition, you need to use those values in the Sub code to do something, otherwise just adding unused parameters serves no purpose.  Because no passed parameter variables are currently used in your Sub and the Sub seems to get the information it needs from the Form combobox states, I would just remove the attempt to pass a parameter from the calling code:

Private Sub cmdNewLayer_Click()
    Call ZoomTasks.ZoomToLandUnit()    �??Your Sub has no argument parameters so do not pass any
End Sub
0 Kudos
Cut_EliaRahmi
Emerging Contributor
Hi Richard,
I get new error now, the properties (.Visible and .Text) of combo boxes don't display automatically to write query code. I write the code in a module. The code runs well when I put it in Sub Command_Button(). I need your suggestion.
Thanks

Amie
0 Kudos
RichardFairhurst
MVP Alum
Below I have revised the code to pass arguments representing the values in the comboboxes and the visible state of the second combobox.  I assume you have a form with these comboboxes that is calling the Sub in another module.  Let me know if this helps.

Private Sub cmdNewLayer_Click()
    Call ZoomTasks.ZoomToLandUnit(cboSatuanLahan.Text,  cboKabupaten.Text,  cboKabupaten.Visible)    �??Assumes this command Button can see the comboboxes.
End Sub

Private Sub UserForm_Initialize()
Dim strFile1 As String
    strFile1 = "D:\AMIE\BELAJAR\Belajar ArcObjects\LandUnit.txt"
    
Dim strLandUnit As String
    
Open strFile1 For Input As #1
    
Do Until EOF(1)
    Input #1, strLandUnit
    cboSatuanLahan.AddItem strLandUnit
Loop
    
Close #1
cboSatuanLahan.Value = "-Land Unit-"
    
Dim strFile2 As String
    strFile2 = "D:\AMIE\BELAJAR\Belajar ArcObjects\Kabupaten.txt"

Dim strKabupaten As String

Open strFile2 For Input As #2

Do Until EOF(2)
    Input #2, strKabupaten
    cboKabupaten.AddItem strKabupaten
Loop

Close #2
cboKabupaten.Value = "-Kabupaten-"
    
End Sub

Public Sub ZoomToLandUnit(byVal strLandUnit As String, byVal strKabupaten as String, byVal bKabupaten as Boolean)

Dim pDocument As IMxDocument
Set pDocument = ThisDocument
Dim pMap As IMap
Set pMap = pDocument.FocusMap
Dim pFeatLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Sub

'set up the selection
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pLayer
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If bKabupaten Then
    pQueryFilter.WhereClause = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & strLandUnit & "'"
End If

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

'access the feature
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pFeatSelection.selectionSet

Dim pDataset As IDataset
Set pDataset = pFeatClass

Set pFeatLayer = pLayer
Set pFeatClass = pFeatLayer.FeatureClass

If pSelectionSet.Count = 0 Then
    MsgBox " The expression was verified successfully, but no records were returned", vbInformation
    Unload Me
    Exit Sub
End If

Dim pFeatCursor As IFeatureCursor
pSelectionSet.Search Nothing, False, pFeatCursor
Dim pFeature As IFeature
Set pFeature = pFeatCursor.NextFeature()

'zoom to all features
Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind

Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelectionSet

Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment

Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)

Dim pFeatLayerDef As IFeatureLayerDefinition
Set pFeatLayerDef = pLayer
If bKabupaten Then
    pFeatLayerDef.DefinitionExpression = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pFeatLayerDef.DefinitionExpression = "Land_Unit = " & "'" & strLandUnit & "'"
End If

'update the extent of the map to match the extent of the feature
Dim pActiveView As IActiveView
Set pActiveView = pMap
pActiveView.Extent = pGeom.Envelope
pActiveView.Refresh

Dim pFeatDef As IFeatureLayerDefinition
Set pFeatDef = pFeatLayer

Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(Soil, True, "", "")

pActiveView.Refresh
pDocument.UpdateContents

End Sub
0 Kudos
Cut_EliaRahmi
Emerging Contributor
Thanks Richard,
No more error from the compiler now, but when I run for the second time it goes to the message box. I open the attribute table and I see only the records of the previous land unit I�??ve chosen, then I compare with the attribute table from the example. The difference is the records from the example attribute table always change every running and mine don�??t. I�??ve also change this line:
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(Soil, True, "", "")
To:
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(strLandUnit, True, "", "")
But still have no change. Please more suggestion.  Thanks a lot Richard..

Amie
0 Kudos
RichardFairhurst
MVP Alum
Thanks Richard,
No more error from the compiler now, but when I run for the second time it goes to the message box. I open the attribute table and I see only the records of the previous land unit I�??ve chosen, then I compare with the attribute table from the example. The difference is the records from the example attribute table always change every running and mine don�??t. I�??ve also change this line:
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(Soil, True, "", "")
To:
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(strLandUnit, True, "", "")
But still have no change. Please more suggestion.  Thanks a lot Richard..

Amie


Try:

Set SelFeatLayer = pFeatDef.CreateSelectionLayer(strLandUnit, True, "", pFeatLayerDef.DefinitionExpression)

Edit:

I think the reason your code does not work a second time is that the definition query of the previous run is stored in the layer, which keeps you from selecting any records that do not match the original values.  You need to clear the defintion query of the layer with each new pass.  So change the beginning to read:

Public Sub ZoomToLandUnit(byVal strLandUnit As String, byVal strKabupaten as String, byVal bKabupaten as Boolean)

Dim pDocument As IMxDocument
Set pDocument = ThisDocument
Dim pMap As IMap
Set pMap = pDocument.FocusMap
Dim pFeatLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Sub

Dim pFeatLayerDef As IFeatureLayerDefinition ' Remove the duplication of this line that appears lower in the code.
Set pFeatLayerDef = pLayer
pFeatLayerDef.DefinitionExpression = ""
' Etc.
0 Kudos
Cut_EliaRahmi
Emerging Contributor
If I delete those lines of code, it only gives blue border to the selection features, but I need it is not only select the fetures but also cut them. So, I also write code to create selection layer. I stiil need your help, thanks Richard..
now, my code looks like this:

Option Explicit

Public Sub ZoomToLandUnit(ByVal strLandUnit As String, ByVal strKabupaten As String, ByVal bKabupaten As Boolean)

Dim pDocument As IMxDocument
Set pDocument = ThisDocument
Dim pMap As IMap
Set pMap = pDocument.FocusMap
Dim pFeatLayer As IFeatureLayer
Dim pFeatClass As IFeatureClass
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Sub

'set up the selection
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pLayer
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If bKabupaten Then
    pQueryFilter.WhereClause = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & strLandUnit & "'"
End If

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

'access the feature
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pFeatSelection.selectionSet

Dim pDataset As IDataset
Set pDataset = pFeatClass

Set pFeatLayer = pLayer
Set pFeatClass = pFeatLayer.FeatureClass

If pSelectionSet.Count = 0 Then
    MsgBox " The expression was verified successfully, but no records were returned", vbInformation
    Unload frmCreateLayout
    Exit Sub
End If

Dim pFeatCursor As IFeatureCursor
pSelectionSet.Search Nothing, False, pFeatCursor
Dim pFeature As IFeature
Set pFeature = pFeatCursor.NextFeature()

'zoom to all features
Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind

Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelectionSet

Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment

Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)

Dim pFeatLayerDef As IFeatureLayerDefinition
Set pFeatLayerDef = pLayer
If bKabupaten Then
    pFeatLayerDef.DefinitionExpression = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pFeatLayerDef.DefinitionExpression = "Land_Unit = " & "'" & strLandUnit & "'"
End If

'update the extent of the map to match the extent of the feature
Dim pActiveView As IActiveView
Set pActiveView = pMap
pActiveView.Extent = pGeom.Envelope
pActiveView.Refresh

Dim pFeatDef As IFeatureLayerDefinition
Set pFeatDef = pFeatLayer

Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFeatDef.CreateSelectionLayer(strLandUnit, True, "", "")

pActiveView.Refresh
pDocument.UpdateContents

End Sub

Public Function CreateSelLayer(ByVal strLandUnit As String, ByVal strKabupaten As String, ByVal bKabupaten As Boolean)

Dim pMxDoc As IMxDocument
Dim pFLayer As IFeatureLayer
Dim pEnumLayer As IEnumLayer
Dim pCurrentLayer As IFeatureLayer
Dim pFClass As IFeatureClass
Dim pFeature As IFeature
Dim pMap As IMap
Dim pLayer As ILayer

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Function
   
'Make a selection on the FeatureLayer
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pLayer
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If bKabupaten = True Then
    pQueryFilter.WhereClause = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & strLandUnit & "'"
End If

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

Dim pFDef As IFeatureLayerDefinition
Set pFDef = pFLayer
      
Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFDef.CreateSelectionLayer(strLandUnit, True, "", "")
   
With pMxDoc
    .AddLayer SelFeatLayer
    .FocusMap.MoveLayer SelFeatLayer, 2
    .FocusMap.ClearSelection
    .activeView.Refresh
    .UpdateContents
End With

End Function
0 Kudos
RichardFairhurst
MVP Alum
I think you are overly complicating this or not telling me what you are realy doing.  Describe the end result better or give me a picture of what you want.  You are making an excesssive number of  defintion query variables that all point to the same layer, so I believe you just need one variable.  You also keep creating the same whereclause, so make that a variable unless you are going to create a variant of the whereclause.

Why are there 2 Subs now and how are they supposed to work together?  Right now they potentially will conflict with each other if they have different input variables and restrict each other from working with all of the features, because they will either be blocked by the definition query of the other or undo the definition query.  Are you trying to create a filtered layer and then create a selectionlayer and then a third selection layer from them that has a subselection?  Or perhaps you do not want your Soils layer to ever have a Definition query that restricts the polygons it displays, in which case you should clear the definition query once you have finished creating a selection and zooming or creating a selection layer.  (Your first sub then should maybe not create a definition query or a Selection layer and just select and zoom to features.)

I still believe you need to clear the DefinitionQuery of the layer first before you select features or else your code will never create a new selection, because it will be blocked by a preexisting defintion query on the second try.  I also got rid of code that seemed to do nothing.  That may break it, but the code needs to be cleaned up.  Your second Sub (not Function) was missing variable assignments and would have thrown errors using Option Explicit, since you did not initialize the pMxDoc or pMap variables or declare an "i" variable for your sub.  I have added those assignments.

Option Explicit

Public Sub ZoomToLandUnit(ByVal strLandUnit As String, ByVal strKabupaten As String, ByVal bKabupaten As Boolean)

Dim pDocument As IMxDocument
Set pDocument = ThisDocument
Dim pMap As IMap
Set pMap = pDocument.FocusMap
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Sub

'set up the selection
Dim pFeatLayer As IFeatureLayer
Set pFeatLayer = pLayer
Dim pFeatDef As IFeatureLayerDefinition
Set pFeatDef = pFeatLayer
pFDef.DefinitionExpression = ""  ' Clear any definition query so your feature selection query is not blocked.
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pFeatLayer
Dim strWhereClause As String
If bKabupaten Then
    strWhereClause = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    strWhereClause = "Land_Unit = " & "'" & strLandUnit & "'"
End If

Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
pQueryFilter.WhereClause = strWhereClause

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

'access the feature
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pFeatSelection.selectionSet

If pSelectionSet.Count = 0 Then
    MsgBox " The expression was verified successfully, but no records were returned", vbInformation
    Unload frmCreateLayout
    Exit Sub
End If

'zoom to all selected features
Dim pEnumGeom As IEnumGeometry
Dim pEnumGeomBind As IEnumGeometryBind

Set pEnumGeom = New EnumFeatureGeometry
Set pEnumGeomBind = pEnumGeom
pEnumGeomBind.BindGeometrySource Nothing, pSelectionSet

Dim pGeomFactory As IGeometryFactory
Set pGeomFactory = New GeometryEnvironment

Dim pGeom As IGeometry
Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)

'update the extent of the map to match the extent of the selected features
Dim pActiveView As IActiveView
Set pActiveView = pMap
pActiveView.Extent = pGeom.Envelope
pActiveView.Refresh

' Do you mean to do this code or do you intend to use the other Sub to do this?
pFDef.DefinitionExpression = strWhereClause ' Do you really want this line to store the definition query on the Soils layer so that it does not display all features?
Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFDef.CreateSelectionLayer(strLandUnit, True, "", "")

With pDocument
    .AddLayer SelFeatLayer
    .FocusMap.MoveLayer SelFeatLayer, 2
    ' .FocusMap.ClearSelection ' Not sure if you want to Clear the Selection.  Remove the first comment quote if you do.
    .activeView.Refresh
    .UpdateContents
End With

End Sub


' This Is not a Function, since it does not return anything.
' THis is a Sub and it is conflicts with the prior Sub unless it is called by the prior Sub only so that it always matches the input variables.
Public Sub CreateSelLayer(ByVal strLandUnit As String, ByVal strKabupaten As String, ByVal bKabupaten As Boolean)

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pLayer As ILayer
Dim i As Long

For i = 0 To pMap.LayerCount - 1
    If pMap.Layer(i).Name = "Soil" Then
        Set pLayer = pMap.Layer(i)
    End If
Next i

If pLayer Is Nothing Then Exit Function
    
Dim pFLayer As IFeatureLayer
Set pFLayer = pLayer
Dim pFDef As IFeatureLayerDefinition
Set pFDef = pFLayer
pFDef.DefinitionExpression = ""    ' Clear any definition query so your feature selection query is not blocked
' or else delete the above line if this Sub is always called by the other sub and always matches its inputs.
'Make a selection on the FeatureLayer
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pFLayer
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New queryFilter
If bKabupaten Then
    pQueryFilter.WhereClause = "Land_Unit = '" & strLandUnit & "' And KABUPATEN = '" & strKabupaten & "'"
Else
    pQueryFilter.WhereClause = "Land_Unit = " & "'" & strLandUnit & "'"
End If

pFeatSelection.Clear
pFeatSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False

Dim SelFeatLayer As IFeatureLayer
Set SelFeatLayer = pFDef.CreateSelectionLayer(strLandUnit, True, "", "")
    
With pMxDoc
    .AddLayer SelFeatLayer
    .FocusMap.MoveLayer SelFeatLayer, 2
    .FocusMap.ClearSelection
    .activeView.Refresh
    .UpdateContents
End With

End Sub
0 Kudos