Есть код двух кнопок. Нажатие первой приводит к загрузке шейп файла и lyr файла к нему. В lyr файле зашиты значки и подписи (labels) к точечным объектам. Значки грузятся, а подписи нет.
Для этого я нашел второй фрагмент кода, который по нажатию второй кнопки позволяет выбрать тот же lyr файл и подгрузить уже labels.
Задача: соединить коды вместе для автоматической подгрузки значков и labels к шейпу.
Код: Выделить всё
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 = "nornikel.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\nornikel.lyr", 1)
Set GetLayer = pGxLayer.Layer
End Function
Private Sub UIButtonControl2_Click()
Dim pGxFile As IGxFile
Dim pGFLayer As IGeoFeatureLayer
Dim pGxLayer As IGxLayer
Dim pGxDialog As IGxDialog
Dim pGxObjFilter As IGxObjectFilter
Dim pEnumGxObj As IEnumGxObject
Dim pAnnoLayerPropsColl As IAnnotateLayerPropertiesCollection
Dim pGxObj As IGxObject
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
If pMxDoc.SelectedLayer Is Nothing Then
MsgBox "Please select feature class to label with .lyr file label classes"
Exit Sub
End If
Set pGxDialog = New GxDialog
Set pGxObjFilter = New GxFilterLayers
Set pGxDialog.ObjectFilter = pGxObjFilter
pGxDialog.Title = "Select Layer(.lyr) file"
pGxDialog.ButtonCaption = "Apply Labels"
If pGxDialog.DoModalOpen(0, pEnumGxObj) Then
Set pGxObj = pEnumGxObj.Next
Set pGxLayer = pGxObj
Else
Exit Sub
End If
Set pGFLayer = pGxLayer.Layer
Set pAnnoLayerPropsColl = pGFLayer.AnnotationProperties
'Apply label classes to selected layer in arcmap
Set pGFLayer = pMxDoc.SelectedLayer
pGFLayer.AnnotationProperties = pAnnoLayerPropsColl
pGFLayer.DisplayAnnotation = True
pMxDoc.ActiveView.Refresh
pMxDoc.CurrentContentsView.Refresh pGFLayer
End Sub