Layering Problem:Assigning multiple objects to a layer removes previous layering

[pandadude]

HI!

I have a massive problem.

Let's say I have 5 objects, object "1" to object "5".

If I assign object "1" to layer "a", object "2" to layer "b", and so on until object "5" to layer "e", and then assign all 5 objects to layer named "all", here's what happens:

1) objects "2" till "5" are removed from layers "b" till "e"

2) All 5 objects are placed in layers "a" and "all"

What I want is for them to stay in their respective layers AS WELL as their newly appointed layer(s). This problem does not occur if I assign objects 1-5 one by one into layer "all".

I'm doing something more complicated with 100 shapes and a few hundred connectors and assigning them one by one is just not acceptable.

Is there a way I can fix this? I couldn't find anything online...

[Paul Herber]

Show us the code you are using for layer assignment.

[pandadude]

i'm not using any code, I'm using the embedded Visio function.

[JohnGoldsmith]

Hi,

I hadn't spotted that before - the dialog uses the selection's primary item. 

I think you'll need a code answer to this one, unless anyone has some shortcuts up their sleeve.

Following is a basic example that you could run if this is a one off.  Of course you could make things more elaborate and add forms if need be or, if code makes you shiver, maybe persuade Paul to add it to his Super Utilities - it looks like a good candidate.

(If you're unsure of running the code then just copy and paste it into the ThisDocument node in the VBE - you might also find this helpful: http://visualsignals.typepad.co.uk/vislog/2007/10/just-for-starte.html )

Code Select Expand


Enum LayerChangeTypes
    AddToLayer
    RemoveFromLayer
End Enum

Public Sub AddSelectionToLayer()
Dim layerName As String
layerName = InputBox("Enter name of layer to add shapes to:", "Add shapes to layer")
Dim targetLayer As Layer
Set targetLayer = GetLayer(ActivePage, layerName)
If Not targetLayer Is Nothing Then
    AddToRemoveFromLayer targetLayer, LayerChangeTypes.AddToLayer
End If
End Sub

Public Sub RemoveSelectionFromLayer()
Dim layerName As String
layerName = InputBox("Enter name of layer to remove shapes from:", "Remove shapes from layer")
Dim targetLayer As Layer
Set targetLayer = GetLayer(ActivePage, layerName)
If Not targetLayer Is Nothing Then
    AddToRemoveFromLayer targetLayer, LayerChangeTypes.RemoveFromLayer
End If
End Sub


Private Sub AddToRemoveFromLayer(ByRef targetLayer As Layer, changeType As LayerChangeTypes, Optional perserveMembers As Integer = 0)
If ActiveWindow.Type = VisWinTypes.visDrawing Then
    Dim vSel As Selection
    Set vSel = ActiveWindow.Selection

    If Not targetLayer Is Nothing Then
        Dim layerUndoScope As Long
        layerUndoScope = Application.BeginUndoScope("Add / remove from layer")
       
        Dim shp As Shape
        For Each shp In vSel
            If changeType = AddToLayer Then
                targetLayer.Add shp, perserveMembers
            Else
                targetLayer.Remove shp, perserveMembers
            End If
        Next
       
        Application.EndUndoScope layerUndoScope, True
       
    End If
End If
End Sub

Private Function GetLayer(ByRef vPag As Page, layerName As String) As Layer
If Not vPag Is Nothing Then
    Set GetLayer = vPag.Layers(layerName)
End If
End Function

If you're interested in other Layers related code then check out the downloadable SDK code library: http://www.microsoft.com/en-us/download/details.aspx?id=36825

Hope that helps.

Best regards

John

[wapperdude]

This alternative approach seems to work too.

Select all of your shapes.  Group them.  Then, with the group selected, assign it to your new layer "all".  You need to select the preserve group member layers option.  Once the group has the layer "all" assigned, ungroup it.  Now each shape should be assigned to both its original layer and to the layer all.

Wapperdude.

[pandadude]

Thanks so much guys! I eventually used wapperdude's method. It's tedious, but it gets the job done. Maybe after this project I'll play around with John's code to see if that works better.

I'm also surprised this hadn't come up before as well. Thanks again for the help.

EDIT: I tried to implement John's code on VBA but could not get it to work. I got this error:

               Cannot create object.

Did I do something wrong? I just copied and pasted John's code into VBA.

EDIT 2: I think the problem is with:

                 vPag.Layers(layerName)

As I think it's different for Visio 2010.

[JohnGoldsmith]

Hi,

Glad that Wapperdude's solution works for you.

For the code, there shouldn't be any difference for 2010 (although I've only run this in 2013), but the error is that a layer of that name couldn't be found.  I forgot that the Item property (default for collections) doesn't return null if it's not in the collection, so here's a quick amend of the GetLayer function:

Code Select Expand

Private Function GetLayer(ByRef vPag As Page, layerName As String) As Layer
If Not vPag Is Nothing Then
    Dim lyr As Layer
    For Each lyr In vPag.Layers
        If lyr.Name = layerName Then
            Set GetLayer = lyr
            Exit Function
        End If
    Next
End If
End Function

The above is now testing for the local name (which is what you see in the UI) and is case sensitive (interestingly, Layers.Item is not).  This will not make any changes or alert you if the entered layer name is not found, so you might want to add an alert for that situation.  For example, you could add the following after the 'Next' statement line:

Code Select Expand

MsgBox "Unable to find layer named '" & layerName & "' in page '" & vPag.Name & "'", vbInformation, "Layer not found"

Hope that helps.

Best regards

John

[pandadude]

Dear John. (Sorry, couldn't help myself)

Thanks for the help, I really appreciate it. Where I have previously used Whapperdude's method before, it has now failed me; it doesn't do what it's supposed to do, but thank god for your timely help. EUREKA! Your code works! (After your adding those lines of code)

However, is it possible to alter the code to allow me to choose a layer from a list of my layers instead of typing the name of the layer correctly each time?

Thanks.

Justin

[wapperdude]

Love the "Dear John"!   

I don't see why the grouping approach would stop "working" as long as you've followed all of the steps or, you're getting an error, possibly too many shapes selected.

But, after thinking about this, here's yet another alternative.  Obviously, you want to be able to toggle selected layers on / off or have all of them on.  Presumably you are doing this thru the "Layers Menu" and just selecting which layers to be visible.  So....

This proposed idea uses the Right Click context menu of the active page.  It requires editing the shapesheet for the page by adding the Action section.  The action menu puts entries into the context menu so that you can choose which layer or all layers with a single click.  When you add a layer to a shape, that layer is added to the Layers section of the page shapesheet.  The Action section must be edited to turn on/off the desired layers.

Anyway, it's just an idea.  Would save the effort of editing the layers for all of your shapes, but, may be too late "in the game" to be useful. 

Attached is a sample of what can be done.  Just right click anywhere on the page, and choose the desired layer to be shown.  Note, it is designed to show only a single layer or all layers, but not random layers, e.g., layer B and layer C.  Behavior can be modified.

BTW "wapperdude", no "h".      

wapperdude

[Yacine]

There's been so many posts about layers.
We (the forum members) should set up and upload a tool comparable to e.g. Autocad's to help setting up layers visibility.
That shouldn't be that difficult.
I'd even follow this thought further to a collection of tools available - open source to anyone - for common tasks.
That's more or less Nikolay's idea explained here: http://visguy.com/vgforum/index.php?topic=5238.msg20657#msg20657
That's definitely an idea to follow.


Regards,
Yacine

[Paul Herber]

I'm quite happy to add some layer handling code as freebie stuff in my utilities. I've got a problem at the moment with renewing my code signing certificate ...