Sub a()
Dim s As String
Dim aLayer As ILayer
Dim a, c As String
Dim pMxdoc As IMxDocument
Set pMxdoc = Application.Document
Dim pMap As iMap
Set pMap = pMxdoc.FocusMap
Dim b As String
b = pMap.name + ":"
Dim pEnumLayer As IEnumLayer
Dim pId As New uid
Dim pparentlayer As ILayer
Dim kolekcia As New Collection
Dim out As Variant
Set pEnumLayer = pMap.LAyers
Set aLayer = pEnumLayer.Next
Do Until aLayer Is Nothing
Set pparentlayer = GetParent(pMxdoc.FocusMap, _
aLayer)
If Not pparentlayer Is Nothing Then
a = a + pparentlayer.name + ":"
End If
s = b + a + aLayer.name
out = s & Chr(13)
kolekcia.Add out
Set aLayer = pEnumLayer.Next
Loop
For Each out In kolekcia
List = List & out
Next
MsgBox b & Chr(13) & List
End Sub
Function GetParent(pMap As iMap, aLayer As ILayer) As ILayer
If pMap.LayerCount = 0 Then Exit Function
Dim pUID As New uid
pUID.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}"
Dim pEnumLayer As IEnumLayer
Set pEnumLayer = pMap.LAyers(pUID, True)
Dim pCLayer As ICompositeLayer
Set pCLayer = pEnumLayer.Next
Do Until pCLayer Is Nothing
Dim k As Integer
For k = 0 To pCLayer.Count - 1
If pCLayer.layer(m) Is aLayer Then
Set GetParent = pCLayer
End If
Next k
Set pCLayer = pEnumLayer.Next
Loop
End Function
Solved! Go to Solution.