POST
|
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
... View more
08-21-2011
05:01 AM
|
0
|
0
|
366
|
POST
|
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
... View more
08-20-2011
09:02 AM
|
0
|
0
|
366
|
POST
|
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
... View more
08-16-2011
08:36 AM
|
0
|
4
|
2275
|
Online Status |
Offline
|
Date Last Visited |
11-11-2020
02:24 AM
|