Select to view content in your preferred language

Layer List recursion

1309
3
07-20-2010 05:48 AM
DanielTuracek
Emerging Contributor
I have this code:

Sub zoznamvrstiev()
    Dim pmxdoc As IMxDocument
        Dim pMap As iMap
        Dim pFeatureLayer As IFeatureLayer
        Dim pFeatureClass As IFeatureClass
        Set pmxdoc = ThisDocument
        Set pMap = pmxdoc.FocusMap
        Dim pEnumLayer As IEnumLayer
        Dim pId As New uid

Dim a As String
a = pMap.name & ":"

    Dim b As String
    Dim player As ILayer
Set pMap = pmxdoc.FocusMap
     pId.value = "{34C20002-4D3C-11D0-92D8-00805F7C28B0}" ' = ILayer
     'pId.value = "{BA119BC4-939A-11D2-A2F4-080009B6F22B}" ' = iComposite
     'pId = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" ' = Igeofeaturelayer
    Set pEnumLayer = pMap.LAyers(pId, True)
    pEnumLayer.Reset
    Set player = pEnumLayer.Next

    Do Until player Is Nothing

    b = b + player.name + ":"

    Dim colection As New Collection
    Dim out As Variant
    Dim c As String
    c = a + b + Chr(13)
    out = c
    colection.Add out
    Set player = pEnumLayer.Next
   
Loop
   
    For Each out In colection
    List = List & out
    Next
    MsgBox a + Chr(13) + List

End Sub
'Private Function Rekursia(player As ILayer)
'  Dim pFeatureLayer As IFeatureLayer
'  Dim pGroup As IGroupLayer
'  Dim pComp As ICompositeLayer
'  Dim i As Long
'  Dim pMap As iMap
'  Dim pmxdoc As IMxDocument
'  Set pmxdoc = ThisDocument
'  Set pMap = pmxdoc.FocusMap
'
'  'Dim i As Integer
'  If TypeOf player Is IGroupLayer Then
'    Set pComp = player
'    For i = 0 To pComp.Count - 1
'        'Rekursia pComp.Layer(i)
'     'MsgBox pComp.Layer(i).name
'    Next i
'
'  Else
'    If (TypeOf player Is IGeoFeatureLayer) Then
'      Set pFeatureLayer = player  'Pre FeatureLayer
'      For i = 0 To pMap.LayerCount - 1
'      'Rekursia pMap.Layer(i)
'
'      Next i
'      'MsgBox pFeatureLayer.name
'    End If
'
'  End If
'MsgBox player.name
'End Function



Its make a list of layers.But its make mistakes. I dont know how to set up the code in way to do what i want.
Its repeating the layername and i dont know why.
Somebody told me that i must do that by recursion.But i dont know how.
In my code is Recursion Function only for your help. I somebody can help me , ill be very thankfull.
0 Kudos
3 Replies
by Anonymous User
Not applicable
I altered your code and the result is the attached screen shot is the result.

Sub zoznamvrstiev()
Dim pmxdoc As IMxDocument
Dim pMap As IMap
Dim pFeatureLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
Set pmxdoc = ThisDocument
Set pMap = pmxdoc.FocusMap
Dim pEnumLayer As IEnumLayer
Dim pId As New UID

Dim a As String
a = pMap.name & ":"

Dim b As String
Dim player As ILayer
Set pMap = pmxdoc.FocusMap
pId.Value = "{34C20002-4D3C-11D0-92D8-00805F7C28B0}" ' = ILayer
'pId.value = "{BA119BC4-939A-11D2-A2F4-080009B6F22B}" ' = iComposite
'pId = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" ' = Igeofeaturelayer
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next

Do Until player Is Nothing

b = player.name

Dim colection As New Collection
Dim out As Variant
Dim c As String
c = a + b + Chr(13)
out = c
colection.Add out
Set player = pEnumLayer.Next

Loop

For Each out In colection
List = List & out
Next
MsgBox a + Chr(13) + List

End Sub
0 Kudos
DanielTuracek
Emerging Contributor
Thank you for your reply
but i need this row
b = b + player.name
its important , because i need all way of layer in TOC. Its better to say that i need copy of treeview in some way.
but thank
0 Kudos
DanielTuracek
Emerging Contributor
This is definetly version:
Sub a()
    Dim s As String
    Dim pLayer As ILayer
    Dim a 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 pLayer = pEnumLayer.Next
Do Until pLayer Is Nothing
  Set pparentlayer = GetParent(pMxDoc.FocusMap, _
                    pLayer)
    If Not pparentlayer Is Nothing Then
        a = a + pparentlayer.name + ":"
    End If
        s = b + a + pLayer.name
        out = s & Chr(13)
        kolekcia.Add out
    Set pLayer = 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 Long
        For k = 0 To pCLayer.Count - 1
            If pCLayer.layer(l) Is alayer Then
                Set GetParent = pCLayer
            End If
        Next k
        Set pCLayer = pEnumLayer.Next
Loop
End Function
0 Kudos