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

Question

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

PhilWarner · Answer

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

JeffreyHamblin · Answer

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 · Answer

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