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