Code to move selected layers to the top of the TOC, ArcMap 9.2 - any help please?

PhilWarner · ‎08-16-2011

Hi there

I'm trying to put together some code that moves any/all selected layers to the top of the Table of Contents. I'm planning to put it on the TOC context menu(s), to let users easily bring to the top just the relevant layers amongst the >50 layers in >8 group layers that are on our standard MXD.

Using the trusty Ctrl-C, Ctrl-V and posts on the old forums by greater minds than mine, i've got:-

[INDENT]Private Sub SortLayers_Click()

Dim pMxDocument As IMxDocument
Dim pContentsView As IContentsView
Set pMxDocument = Application.Document
Set pContentsView = pMxDocument.CurrentContentsView

Dim pMap As IMap
Set pMap = pMxDocument.FocusMap

Dim pSelectedItem As Variant
Dim pLayer As ILayer
Dim pSetItem As Variant
Dim pSelectionSet As ISet

If Not IsNull(pContentsView.SelectedItem) Then
    Set pSelectedItem = pContentsView.SelectedItem

    If TypeOf pSelectedItem Is ILayer Then
      Set pLayer = pSelectedItem
      pMap.MoveLayer pLayer, 0

    ElseIf TypeOf pSelectedItem Is ISet Then
      Set pSelectionSet = pSelectedItem
      pSelectionSet.Reset
      For Count = 0 To pSelectionSet.Count - 1
        Set pSetItem = pSelectionSet.Next
        If TypeOf pSetItem Is ILayer Then
          Set pLayer = pSetItem
          pMap.MoveLayer pLayer, 0
        End If
      Next Count
    End If

End If

End Sub[/INDENT]

...which does the job except for one slightly unfortunate side-effect - if the selected layer is within a group layer then the entire group layer goes AWOL:eek:

Any ideas gratefully received! Maybe something using ICompositeLayer?

Phil

ChaoWang · ‎08-18-2011

Hello Phil,

IMapLayers.MoveLayerEx Method can be used to move sub layer from group layer to top of the Map. Here's what you need to do:

1) Loop through all layers to check if the selected layer is in a group layer, if so, get that GroupLayer object from the Map
2) Use IMapLayers.MoveLayerEx Method:
Link:
http://help.arcgis.com/en/sdk/10.0/arcobjects_net/componenthelp/index.html#/MoveLayerEx_Method/00120...

Public Sub MoveLayerEx ( _
    ByVal pFromGroup As IGroupLayer, _
    ByVal pToGroup As IGroupLayer, _
    ByVal pLayer As ILayer, _
    ByVal newPosition As Integer _
)
where: pFromGroup is the group layer where the sub layer is coming from, pToGroup is nothing (so that the layer will be moved to the map), pLayer is the layer which will be moved, newPosition is 0 in this case.

A small code snippet to move the selected sub layer from the group layer (first layer in the map) to the top of the map (based on your code). I understand that you would like to move probably more than one layers, you can modify the code based on the snippet below:

'=========================================
Private Sub MoveLayersFromGroupLayer2Map()

Dim pMxDocument As IMxDocument
Dim pContentsView As IContentsView
Set pMxDocument = Application.Document
Set pContentsView = pMxDocument.CurrentContentsView

Dim pMap As IMap
Set pMap = pMxDocument.FocusMap

Dim pMapLayers As IMapLayers
Set pMapLayers = pMap

'For example, the selected layer is from the first layer (group layer) in the map
Dim pGroupLayer As IGroupLayer
Set pGroupLayer = pMap.Layer(0)

Dim pSelectedItem As Variant
Dim pLayer As ILayer

If Not IsNull(pContentsView.SelectedItem) Then
Set pSelectedItem = pContentsView.SelectedItem

If TypeOf pSelectedItem Is ILayer Then
Set pLayer = pSelectedItem
' Move the sub layer from the group layer to the top of the map
pMapLayers.MoveLayerEx pGroupLayer, Nothing, pLayer, 0
End If

End If

End Sub

'=============================================

Hope it helps,

Chelsea

PhilWarner · ‎08-20-2011

Thanks Chelsea:)

Shame there's no nice simple way to check if a layer is within a Group Layer, to use with your MoveLayerEx.

Anyway I did roughly what you advised (i hope!) and the function is kind-of working now.

Without On Error Resume Next it falls over, cos as soon as it has moved a layer out of a Group Layer then the looping-through fails as the number of layers is no longer valid. I guess there's a way to deal with this properly but my attempts failed:( As it is now, it works in most cases but sometimes fails to move a couple of the selected layers towards the bottom. At least it doesn't delete them like my first dodgy attempt!

Thanks for your help

Phil

Sub MoveLayersToTop()

      Dim pMxDoc As IMxDocument
      Set pMxDoc = ThisDocument

      Dim pCV As IContentsView
      Set pCV = pMxDoc.CurrentContentsView

      Dim pMap As IMap
      Set pMap = pMxDoc.FocusMap
      Dim pMapLayers As IMapLayers
      Set pMapLayers = pMap

      Dim pLayer As ILayer
      Dim pLayer2 As ILayer
      Dim pLayer3 As ILayer
      Dim pSubLayer As ILayer

      Dim pCompLayer As ICompositeLayer
      Dim pCompLayer2 As ICompositeLayer

      Dim lngX As Long
      Dim lngY As Long
      Dim lngZ As Long

      Dim pSelectedItem As Variant
      Dim pSetItem As Variant
      Dim pSelectionSet As ISet

      'get selected layers
      Dim pFLayer As IFeatureLayer
      Dim TheSelectionSet As esriSystem.ISet
      Set TheSelectionSet = New esriSystem.Set

      If (TypeOf pCV.SelectedItem Is IFeatureLayer) Then
        TheSelectionSet.Add (pCV.SelectedItem)
      ElseIf (TypeOf pCV.SelectedItem Is ISet) Then
        Set TheSelectionSet = pCV.SelectedItem
      End If

      '1-Go through every layer in TOC
      For lngX = 0 To pMxDoc.FocusMap.LayerCount - 1
       On Error Resume Next
       Set pLayer = pMxDoc.FocusMap.Layer(lngX)

        '2a-For a normal layer not in any group layer
        If Not TypeOf pLayer Is IGroupLayer Then
            If TheSelectionSet.Find(pLayer) Then
             pMap.MoveLayer pLayer, 0
             'Wilma = MsgBox(pLayer.Name, , "Not Grouped")
            End If
        End If

        '2b-If finds layer is Group Layer, then check within...
        If TypeOf pLayer Is IGroupLayer Then
            Set pCompLayer = pLayer

            '3-Go through every layer in the Group Layer
            For lngY = 0 To pCompLayer.Count - 1
            On Error Resume Next
                Set pLayer2 = pCompLayer.Layer(lngY)

                '4a-For a normal layer within the Group Layer
                    If Not TypeOf pLayer2 Is IGroupLayer Then
                      If TheSelectionSet.Find(pLayer2) Then
                      pMapLayers.MoveLayerEx pCompLayer, Nothing, pLayer2, 0
                      'Wilma = MsgBox(pLayer2.Name, , pLayer.Name)
                      End If
                    End If

                 '4b-If finds a Group Layer within the Group Layer...
                  If TypeOf pLayer2 Is IGroupLayer Then
                    Set pCompLayer2 = pLayer2

                        '5-Go through every layer in the Group-within-Group
                        For lngZ = 0 To pCompLayer2.Count - 1
                        On Error Resume Next

                            '6-For a normal layer within the Group-within-Group
                            If Not TypeOf pCompLayer2.Layer(IngZ) Is IGroupLayer Then
                              Set pLayer3 = pCompLayer2.Layer(lngZ)
                              If TheSelectionSet.Find(pLayer3) Then
                              pMapLayers.MoveLayerEx pCompLayer2, Nothing, pLayer3, 0
                              'Wilma = MsgBox(pLayer3.Name, , pLayer2.Name & " " & pLayer.Name)
                              End If
                            End If

                        'End 5
                        Next lngZ
                    'End 4b
                    End If
                'End 3
                Next lngY
            'End 2b
            End If
      'End 1
      Next lngX

End Sub

JeffreyHamblin · ‎08-20-2011

Regarding removing items from a list in a For loop, you can run them in reverse to avoid the invalid index(es) at the end:

For lngX = pMxDoc.FocusMap.LayerCount - 1 To 0 Step -1

And you might want to look at using a recursive function to handle digging through group layers.

PhilWarner · ‎08-21-2011

Thanks Jeff - very cunning - working through in reverse does indeed stop the errors...but in practice less layers get moved.

Although it's a bit ugly, the best results i've had so far is with putting back the On Error Resume Next and getting it to look through more layers than are in the pMxDoc.FocusMap.LayerCount in the first place.   I.e. instead of my original:-
   For lngX = 0 To pMxdoc.FocusMap.LayerCount - 1
...or your...
   For lngX = pMxdoc.FocusMap.LayerCount - 1 To 0 Step -1
...using...
   For lngX = 0 To (pMxdoc.FocusMap.LayerCount + 100)
- that way it doesn't ignore layers due to the re-ordering.

So the latest version is:-

Sub tester()

      Dim pMxdoc As IMxDocument
      Set pMxdoc = ThisDocument

      Dim pCV As IContentsView
      Set pCV = pMxdoc.CurrentContentsView

      Dim pMap As IMap
      Set pMap = pMxdoc.FocusMap
      Dim pMapLayers As IMapLayers
      Set pMapLayers = pMap

      Dim pLayer As ILayer
      Dim pLayer2 As ILayer
      Dim pLayer3 As ILayer
      Dim pSubLayer As ILayer

      Dim pCompLayer As ICompositeLayer
      Dim pCompLayer2 As ICompositeLayer

      Dim lngX As Long
      Dim lngY As Long
      Dim lngZ As Long

      Dim pSelectedItem As Variant
      Dim pSetItem As Variant
      Dim pSelectionSet As ISet

      'get selected layers
      Dim pFLayer As IFeatureLayer
      Dim TheSelectionSet As esriSystem.ISet
      Set TheSelectionSet = New esriSystem.Set


      If (TypeOf pCV.SelectedItem Is IFeatureLayer) Then
        TheSelectionSet.Add (pCV.SelectedItem)
      ElseIf (TypeOf pCV.SelectedItem Is ISet) Then
        Set TheSelectionSet = pCV.SelectedItem
      End If

      '1-Go through every layer in TOC
      'For lngX = pMxdoc.FocusMap.LayerCount - 1 To 0 Step -1
      'For lngX = 0 To pMxdoc.FocusMap.LayerCount - 1
      For lngX = 0 To (pMxdoc.FocusMap.LayerCount + 100)
      On Error Resume Next
       Set pLayer = pMxdoc.FocusMap.Layer(lngX)

        '2a-For a normal layer not in any group layer
        If Not TypeOf pLayer Is IGroupLayer Then
            If TheSelectionSet.Find(pLayer) Then
             pMap.MoveLayer pLayer, 0
             'Wilma = MsgBox(pLayer.Name, , "Not Grouped")
            End If
        End If

        '2b-If finds layer is Group Layer, then check within...
        If TypeOf pLayer Is IGroupLayer Then
            Set pCompLayer = pLayer

            '3-Go through every layer in the Group Layer
            'For lngY = pCompLayer.Count - 1 To 0 Step -1
            'For lngY = 0 To pCompLayer.Count - 1
            For lngY = 0 To (pCompLayer.Count + 100)
            On Error Resume Next
                Set pLayer2 = pCompLayer.Layer(lngY)

                '4a-For a normal layer within the Group Layer
                    If Not TypeOf pLayer2 Is IGroupLayer Then
                      If TheSelectionSet.Find(pLayer2) Then
                      pMapLayers.MoveLayerEx pCompLayer, Nothing, pLayer2, 0
                      'Wilma = MsgBox(pLayer2.Name, , pLayer.Name)
                      End If
                    End If

                 '4b-If finds a Group Layer within the Group Layer...
                  If TypeOf pLayer2 Is IGroupLayer Then
                    Set pCompLayer2 = pLayer2

                        '5-Go through every layer in the Group-within-Group
                        'For lngZ = pCompLayer2.Count - 1 To 0 Step -1
                        'For lngZ = 0 To pCompLayer2.Count - 1
                        For lngZ = 0 To (pCompLayer2.Count + 100)
                        On Error Resume Next

                            '6-For a normal layer within the Group-within-Group
                            If Not TypeOf pCompLayer2.Layer(IngZ) Is IGroupLayer Then
                              Set pLayer3 = pCompLayer2.Layer(lngZ)
                              If TheSelectionSet.Find(pLayer3) Then
                              pMapLayers.MoveLayerEx pCompLayer2, Nothing, pLayer3, 0
                              'Wilma = MsgBox(pLayer3.Name, , pLayer2.Name & " " & pLayer.Name)
                              End If
                            End If

                        'End 5
                        Next lngZ
                    'End 4b
                    End If
                'End 3
                Next lngY
            'End 2b
            End If
      'End 1
      Next lngX

End Sub