Layers

DanielTuracek

i have dataframe with these layers:

and i have this code:

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

which gives me this msgbox:



As you can see i want to get something like layers tree from this code. but there is mistake."New group layer" is repeatly appearing there where it isnt correct.
can anybody responsible who is good programmer explain what i doing bad?
Or have anyone of you another code for that?

msgbox.JPG

treeview.JPG

Anonymous User

Original User: thaviti

Please find the explanation against lines

Sub GetLayerNames()
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 ''get the active map
Dim b As String
b = pMap.Name + ":"
Dim pEnumLayer As IEnumLayer
Dim pId As New UID
Dim pparentlayer As ILayer
Dim coll As New Collection
Dim out As Variant
Set pEnumLayer = pMap.Layers(Nothing, False)
''As second parameter is False, this Gets the immediate Layers in the map. i.e. only the direct layers ''under map

Set aLayer = pEnumLayer.Next ''loop through retrieved layer enumeration
Dim parentLayerName As String

Do Until aLayer Is Nothing
coll.Add b & aLayer.Name ''add the layer name appended with map name to the collection

''If the layer is GroupLayer then process its child layers
If (TypeOf aLayer Is IGroupLayer) Then

''Pass the layer and the layer full name (Map name + layer name) to the method along with the ''collection variable

AddLayerNames aLayer, b & ":" & aLayer.Name, coll

End If

''Get the next layer in the enumeration and process the same

Set aLayer = pEnumLayer.Next
Loop

For Each out In coll
List = List & out & vbNewLine
Next

MsgBox b & Chr(13) & List

End Sub

''This method adds the child layer name's in the group layer to the collection. If the child layer is ''also a group layer then that child layer itself is proceed with this method to get its child layer ''names and the same to the collection variable.

Sub AddLayerNames(pGroupLayer As IGroupLayer, pGroupLayerFullName As String, ByRef collectionVariable As Collection)

If pGroupLayer Is Nothing Then Exit Sub

Dim compLayer As ICompositeLayer
Set compLayer = pGroupLayer
Dim childLayer As ILayer


Dim i As Integer
For i = 0 To compLayer.count - 1
Set childLayer = compLayer.Layer(i)


collectionVariable.Add pGroupLayerFullName & ":" & childLayer.Name

''append the child layer name to parent layer full name and pass the same to the method to process ''for child layers

If TypeOf childLayer Is IGroupLayer Then
AddLayerNames childLayer, pGroupLayerFullName & ":" & childLayer.Name, collectionVariable
End If

Next

End Sub