Загрузка shp по нажатию кнопки

[XdenisX]

Товарищи!

Хочу сделать UIButton который подгружал бы shp файл из определенной директории и легенду к нему на карту. Где можно найти пример?

[XdenisX]

Шейп удалось загрузить, также сделал загрузку lyr файла к нему.
Привожу код:

Код: Выделить всё

Public Sub UIButtonControl1_Click()
'  эта функция добавляет ShapeFile по нажатию кнопки
  Dim pWorkspaceFactory As IWorkspaceFactory
  Dim pFeatureWorkspace As IFeatureWorkspace
  Dim pFeatureLayer As IFeatureLayer
  Dim pMxDocument As IMxDocument
  Dim pMap As IMap
  
  'Create a new ShapefileWorkspaceFactory object and open a shapefile folder
  Set pWorkspaceFactory = New ShapefileWorkspaceFactory
  'Путь к директории с шейпом
  Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile("C:\Denis\NorNikel\nn\", 0)
  'Create a new FeatureLayer and assign a shapefile to it
  Set pFeatureLayer = New FeatureLayer
  ' Имя шейпа без расширения
  Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass("nornikel")
  pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
  'Add the FeatureLayer to the focus map
  Set pMxDocument = Application.Document
  Set pMap = pMxDocument.FocusMap
  pMap.AddLayer pFeatureLayer

' Загрузки собственной легенды для выбранного слоя
Dim Own_Catalog As String, Lyr_Name As String
    Own_Catalog = "C:\Denis\NorNikel\nn\"
    Lyr_Name = "Denis.lyr"
    Call LoadLegend(pFeatureLayer, Own_Catalog, Lyr_Name)  'Загрузка легенды
End Sub

Private Sub LoadLegend(pGFLayer As IGeoFeatureLayer, Own_Catalog As String, Lyr_Name As String)
    '
    ' loads the renderer from a .lyr file
    ' and applies it to the selected layer
    '
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    Dim pFRenderer As IFeatureRenderer
            Set pFRenderer = GetRenderer(Own_Catalog, Lyr_Name)
            
            If Not pFRenderer Is Nothing Then
                Set pGFLayer.Renderer = pFRenderer
                pMxDoc.CurrentContentsView.Refresh pGFLayer
                Dim pAV As IActiveView
                Set pAV = pMxDoc.FocusMap
                pAV.Refresh
            End If
    End Sub

Function GetRenderer(Own_Catalog As String, Lyr_Name As String) As IFeatureRenderer
    Dim pGFLayer As IGeoFeatureLayer
    Set pGFLayer = GetLayer(Own_Catalog, Lyr_Name)
    If Not pGFLayer Is Nothing Then
        Set GetRenderer = pGFLayer.Renderer
    End If   
End Function

Function GetLayer(Own_Catalog As String, Lyr_Name As String) As ILayer
 Dim pGxLayer As IGxLayer
         Dim MyLayer As ILayer
        Dim MyGxObject As IGxObject
        Dim pCat As IGxCatalog
        Dim pDlg As IGxDialog
        Set pDlg = New GxDialog
        Set pCat = pDlg.InternalCatalog
        pCat.Location = Own_Catalog
        Set pGxLayer = pCat.GetObjectFromFullName("C:\Denis\NorNikel\nn\Denis.lyr", 1)
        Set GetLayer = pGxLayer.Layer  
End Function

Теперь хочется как-то автоматизировать подгруку Labels к каждому из точечных объектов, значения которых будут браться из одного из полей атрибутов шейпа (дата). Как такое возможно реализовать?