nav[aria-label="Primary Navigation"] { padding: 0; & ul { list-style: none; width: 100%; display: flex; flex-direction: row; justify-content: start; align-items: start; gap: 30px; padding: 0; & li { margin: 0; } & ul li { list-style: none; } } }

confusing query filter

Cut_EliaRahmi

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

Trouver plus de publications taguées avec

Accepted answers

All comments

RichardFairhurst

I have corrected the definition query statement in bold where you misspelled the field name (you left out an underscore). It should work with that correction.

Option Explicit

Private pMxDoc As IMxDocument
Private pFLayer As IFeatureLayer
Private pEnumLayer As IEnumLayer
Private pCurrentLayer As IFeatureLayer
Private pFClass As IFeatureClass
Private pFeature As IFeature

Public Sub ZoomToSDnumber(SDnumberId 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 = "SD_NUMBER = '" & SDnumberId & "'"
    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 = "SD_NUMBER='" & SDnumberId & "'"        
    pActView.Refresh
    pMxDoc.UpdateContents
    

End Sub


Public Function CreateSelLayer(SDnumberId As String)

    Set pMxDoc = ThisDocument
    Set pFLayer = pMxDoc.FocusMap.Layer(0)
    
    ''** Make a selection on the FeatureLayer
    Dim queryStr As String
    Dim qF As IQueryFilter
    Set qF = New QueryFilter
    queryStr = "SD_NUMBER='" & SDnumberId & "'"
    qF.WhereClause = queryStr
    Dim pFSel As IFeatureSelection
    Set pFSel = pFLayer
    pFSel.SelectFeatures qF, esriSelectionResultNew, False
    
    Dim pFDef As IFeatureLayerDefinition
    Set pFDef = pFLayer
    
    
    Dim SelFeatLayer As IFeatureLayer
    Set SelFeatLayer = pFDef.CreateSelectionLayer(StateId, True, "", "")
    
    With pMxDoc
        .AddLayer SelFeatLayer
        .FocusMap.MoveLayer SelFeatLayer, 2
        .FocusMap.ClearSelection
        .ActiveView.Refresh
        .UpdateContents
    End With
    
    


End Function

hamadaltuwaijri

Hi,
I am having problem with my code I am trying to use zoom Modules in my project, BUT
after I run the code, it goes directly to the layer but with deleting all the information in Attribute table?

here is my code ?

Option Explicit

Private pMxDoc As IMxDocument
Private pFLayer As IFeatureLayer
Private pEnumLayer As IEnumLayer
Private pCurrentLayer As IFeatureLayer
Private pFClass As IFeatureClass
Private pFeature As IFeature

Public Sub ZoomToSDnumber(SDnumberId 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 = "SD_NUMBER = '" & SDnumberId & "'"
    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 = "SDNUMBER='" & SDnumberId & "'"

    pActView.Refresh
    pMxDoc.UpdateContents


End Sub

Public Function CreateSelLayer(SDnumberId As String)

    Set pMxDoc = ThisDocument
    Set pFLayer = pMxDoc.FocusMap.Layer(0)

    ''** Make a selection on the FeatureLayer
    Dim queryStr As String
    Dim qF As IQueryFilter
    Set qF = New QueryFilter
    queryStr = "SD_NUMBER='" & SDnumberId & "'"
    qF.WhereClause = queryStr
    Dim pFSel As IFeatureSelection
    Set pFSel = pFLayer
    pFSel.SelectFeatures qF, esriSelectionResultNew, False

    Dim pFDef As IFeatureLayerDefinition
    Set pFDef = pFLayer


    Dim SelFeatLayer As IFeatureLayer
    Set SelFeatLayer = pFDef.CreateSelectionLayer(StateId, True, "", "")

    With pMxDoc
        .AddLayer SelFeatLayer
        .FocusMap.MoveLayer SelFeatLayer, 2
        .FocusMap.ClearSelection
        .ActiveView.Refresh
        .UpdateContents
    End With



End Function

Cut_EliaRahmi

I just use the first Sub, delete the Definition Query whereclause and clear the selection at the end of the Sub. Thanks Richard..

RichardFairhurst

I followed an example from an arcobjects' book how to create selection layer, but I need to modify in part of query and zoom to feature, when I got stuck in query, I ask to this forum by the title confusing query filter. Now, the problem is solved. Thanks Richard, Thank you so much..

Regards,

Amie

I am glad it is working for you now. Did you end up with just the first Sub or did you keep 2 Subs? Did you end up keeping the line that stored the Definition Query whereclaues on the Soils layer or deleting it? Did you leave the features selected or clear the selection at the end of the Sub? Just curious to know what behaviors you ultimately were looking for.

Cut_EliaRahmi

I followed an example from an arcobjects' book how to create selection layer, but I need to modify in part of query and zoom to feature, when I got stuck in query, I ask to this forum by the title confusing query filter. Now, the problem is solved. Thanks Richard, Thank you so much..

Regards,

Amie

RichardFairhurst

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

Cut_EliaRahmi

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

RichardFairhurst

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.

Cut_EliaRahmi

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

RichardFairhurst

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

Cut_EliaRahmi

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

RichardFairhurst

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

Cut_EliaRahmi

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

RichardFairhurst

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 " ".

Rejoindre la conversation

Les membres connectés peuvent publier, suivre les mises à jour, et plus encore. Nouveau ici ? Inscrivez-vous gratuitement.

Liens rapides

Community Help
Find useful guides, FAQs, and documents to help you navigate and make the most of Esri Community.