Поиск объектов

Question

Всем привет. Нужно запрограммировать свою кнопку  на VB6, при нажатии на которую выделялся  объект на карте из определенного слоя.
Пробовал как в этой теме https://forum.esri-cis.ru/index.php?qa=35643 но сист ругается на  FindLayer.
Код:
Private Sub CommandButton1_Click()
Dim name_route As String
name_route = ComboBox2.Text
Dim mxDoc As IMxDocument
Set mxDoc = Application.Document
'поиск слоя, из которого будет производиться выборка
Dim lyr As IFeatureLayer

Select Case ComboBox1.ListIndex
Case 0: 'Трамвай
Set lyr = FindLayer(mxDoc.FocusMap, "Трамвай")
'получение интерфейса выборки
Dim sel As IFeatureSelection
Set sel = lyr
'создание фильтра запроса
Dim filter As IQueryFilter
Set filter = New QueryFilter
'установка WHERE-запроса и пространственной привязки
filter.WhereClause = "Num_route =" + ComboBox2.Text
Dim shapeField As String
shapeField = lyr.FeatureClass.ShapeFieldName
Set filter.OutputSpatialReference(shapeField) = mxDoc.FocusMap.SpatialReference
'очистка существующей выборки на экране
mxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
'выбор объектов и установка новой выборки
sel.SelectFeatures filter, esriSelectionResultNew, False
mxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
Dim selEvents As ISelectionEvents
Set selEvents = mxDoc.FocusMap
selEvents.SelectionChanged


Case 1: 'Троллейбус
Set lyr = FindLayer(mxDoc.FocusMap, "Троллейбус")

Case 2: 'Автобус
Set lyr = FindLayer(mxDoc.FocusMap, "Автобус")

Case 3: 'Метро
Set lyr = FindLayer(mxDoc.FocusMap, "Метро")

Case 4: 'Станции метро
Set lyr = FindLayer(mxDoc.FocusMap, "Станции метро")
End Select




End Sub

Answer 1

            Public Function FindLayer(ByRef sName As String) As ESRI.ArcGIS.Carto.ILayer
            'UPGRADE_NOTE: Object FindLayer may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
            FindLayer = Nothing
            Dim pMap As ESRI.ArcGIS.Carto.IMap = mxDoc.FocusMap
            If (pMap Is Nothing) Then
               MsgBox("Layer not found: " & sName)
               Exit Function
            End If
            Dim pUID As ESRI.ArcGIS.esriSystem.UID
            'UPGRADE_NOTE: Object pUID may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
            pUID = Nothing
            Dim pLayers As ESRI.ArcGIS.Carto.IEnumLayer
            pLayers = pMap.Layers(pUID, True)
            Dim pLayer As ESRI.ArcGIS.Carto.ILayer
            pLayer = pLayers.Next
            While (Not pLayer Is Nothing)
               If (pLayer.Name = sName) Then
                    FindLayer = pLayer
                    Exit Function
               End If
               pLayer = pLayers.Next
            End While
            Exit Function
        End Function
    

Answer 2

(( выдает ошибку на строчку  Dim pMap As ESRI.ArcGIS.Carto.IMap = mxDoc.FocusMap

Answer 3

Извиняюсь, кажеться надо так:
Dim pMap As ESRI.ArcGIS.Carto.IMap = mxDoc.ActiveView.FocusMap
Нет под рукой VB, чтобы проверить синтаксис. И mxDoc обявить в начале класса.
    
    
    

Answer 4

спасибо!!
Но я сделал по другому. Только я не знаю, как сделать так что бы найденный объект централизовался по карте
Код
Private Sub CommandButton1_Click()
' Part 1: Define the feature layer.
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pFeatureLayer As IFeatureLayer
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Set pActiveView = pMap
Set pFeatureLayer = pMap.Layer(i)
i = ComboBox1.Text
' Part 2: Select features.
Dim pQueryFilter As IQueryFilter
Dim pFeatureSelection As IFeatureSelection
' Prepare a query filter.
Set pQueryFilter = New QueryFilter
pQueryFilter.WhereClause = "NAME = " + "'" + ComboBox2.Text + "'"
' Refresh the old selection if any to erase it.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
' Select features.
Set pFeatureSelection = pFeatureLayer
pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
' Refresh again to draw the new selection.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
End Sub

Answer 5

            Dim u As New ESRI.ArcGIS.esriSystem.UID
        Dim pCmdItem As ICommandItem
        Try
            u.Value = "{AB073B49-DE5E-11D1-AA80-00C04FA37860}"
            u.SubType = 3
            pCmdItem = m_application.Document.CommandBars.Find(u)


        Catch ex As Exception

        End Try

Можно так, это просто вызываеться инструметн zoom to select, но при этом нужно чтобы на карте были выбраны только вам нужные объекты и не было другой выборки.

Откуда берете номер слоя в pMap.Layer(i)?


    
    
    

Answer 6

упс точно так нельзя выбрать слой(( не подскажешь как сделать, а то я пробывал как в первом сообщении, но сист ругается на FindLayer

Answer 7

Еще раз извиняюсь не внимательно просматрел Ваш код. У вас в функции FindLayer еще есть параметр IMap. Попробуте так:           
Public Function FindLayer(ByRef pMap as IMap, ByRef sName As String) As ESRI.ArcGIS.Carto.ILayer
             'UPGRADE_NOTE: Object FindLayer may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
             FindLayer = Nothing
            If (pMap Is Nothing) Then
               MsgBox("Layer not found: " & sName)
               Exit Function
            End If
            Dim pUID As ESRI.ArcGIS.esriSystem.UID
            'UPGRADE_NOTE: Object pUID may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
             pUID = Nothing
            Dim pLayers As ESRI.ArcGIS.Carto.IEnumLayer
            pLayers = pMap.Layers(pUID, True)
            Dim pLayer As ESRI.ArcGIS.Carto.ILayer
            pLayer = pLayers.Next
            While (Not pLayer Is Nothing)
               If (pLayer.Name = sName) Then
                    FindLayer = pLayer
                    Exit Function
               End If
               pLayer = pLayers.Next
            End While
            Exit Function
        End Function
и получение слоя будет выглядеть так:
Dim pMap as IMap = pMxDoc.ActiveView.FocusMap
lyr = FindLayer(pMap, "Троллейбус")

    
    
    

Answer 8

блин все равно не получается, лучше подскажите как сделать чтобы можно было выбирать слой по этому коду
Private Sub CommandButton1_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pFeatureLayer As IFeatureLayer
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Set pActiveView = pMap
Set pFeatureLayer = pMap.Layer(0) вот здесь происходит выборка только по первому слою, а надо чтобы можно было выбирать слой из списка в комбобоксе или др.
Dim pQueryFilter As IQueryFilter
Dim pFeatureSelection As IFeatureSelection
' Prepare a query filter.
Set pQueryFilter = New QueryFilter
pQueryFilter.WhereClause = "NAME = " + "'" + ComboBox2.Text + "'"   'у меня в каждом слое есть NAME и только по этому атрибуту происходит поиск объектов
' Refresh the old selection if any to erase it.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
' Select features.
Set pFeatureSelection = pFeatureLayer
pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
' Refresh again to draw the new selection.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
End Sub
Мне нужно найти и выделить объект в центре экрана

Answer 9

Это код формы. На ней Combo, TextBox, Button



Dim pMxDoc As IMxDocument

Private Sub CommandButton1_Click() ' Выбираем объект на карте в слое определенном в Combo и выполняем zoom to select
Dim pLayer As ILayer
Dim pMap As IMap
Dim pActiveView As IActiveView
Set pMap = pMxDoc.ActiveView.FocusMap
Set pLayer = FindLayer(pMap, ComboBox1.Text)
Set pActiveView = pMap
Dim pFeatureLayer As IFeatureLayer

Set pFeatureLayer = pLayer
Dim pQueryFilter As IQueryFilter
Dim pFeatureSelection As IFeatureSelection
' Prepare a query filter.
Set pQueryFilter = New QueryFilter
pQueryFilter.WhereClause = TextBox1.Text ' Параметр запроса
' Refresh the old selection if any to erase it.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
' Select features.
Set pFeatureSelection = pFeatureLayer
pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
' Refresh again to draw the new selection.
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
pActiveView.Refresh

'Zoom to select
        Dim u As New UID
        Dim pCmdItem As ICommandItem
            u.Value = "{AB073B49-DE5E-11D1-AA80-00C04FA37860}"
            u.SubType = 3
            Set pCmdItem = ThisDocument.CommandBars.Find(u)
        pCmdItem.Execute
        pActiveView.Refresh
End Sub

Private Sub UserForm_Initialize() ' Загружаем в Combo список слоев
Set pMxDoc = ThisDocument
        Dim pUID As UID
        Set pUID = Nothing
        Dim pLayers As IEnumLayer
        Set pLayers = pMxDoc.ActiveView.FocusMap.Layers(pUID, True)
        Dim pLayer As ILayer
        Set pLayer = pLayers.Next
        While (Not pLayer Is Nothing)
            ComboBox1.AddItem pLayer.Name
            Set pLayer = pLayers.Next
        Wend
End Sub

    Public Function FindLayer(ByRef pMap As IMap, ByRef sName As String) As ILayer ' Функция поиска слоя, возвращает слой Ilayer
        'UPGRADE_NOTE: Object FindLayer may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        Set FindLayer = Nothing
        If (pMxDoc.ActiveView.FocusMap Is Nothing) Then
            MsgBox ("Layer not found: " & sName)
            Exit Function
        End If
        Dim pUID As UID
        'UPGRADE_NOTE: Object pUID may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
        Set pUID = Nothing
        Dim pLayers As IEnumLayer
        Set pLayers = pMxDoc.ActiveView.FocusMap.Layers(pUID, True)
        Dim pLayer As ILayer
        Set pLayer = pLayers.Next
        While (Not pLayer Is Nothing)
            If (pLayer.Name = sName) Then
               Set FindLayer = pLayer
               Exit Function
            End If
            Set pLayer = pLayers.Next
        Wend
        Exit Function
    End Function
    

Answer 10

о спасибо большое!!!!!!!!!, ща попробую