Hello, can you help me, please?
How can I iterate throught all shapes, that belong to given layer?
I`m wondering about perfomance issues - is it faster than looping throught all shapes on given page?
I don't know, that you can iterate through all shapes on a given layer.
I would have thought you had to iterate through all the shapes on the page and for each look if ir's on the layer.
You can create a selection of all the shapes on a layer, but this needs to be done for each page.
For Each vsoPage in ThisDocument.Pages
Set vsoAnnotationLayer = vsoPage.Layers("MyLayer")
Set vsoSelection = vsoPage.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, vsoLayer)
'Process the shapes in the selection
Next
Thank you, Andy!
Is it faster or slower than iterating throught all shapes on the page and checking their layers?
Not timed it both ways, but would hope Visio would be faster although it may well be doing pretty much the same but I guess that depends how it internally holds the information.
Shapes aren't organised in that way, a layer cannot be treated as a collection. I guess this might be because shapes can be on multiple layers, and, grouped shapes can have different parts of the group on different layers. I think just this last aspect would prevent the ability to treat layers as iterable collections.
You can loop through all the shapes and test layer membership, but also if the shape is grouped then you have to iterate through the sub-shapes as well, and recursively, groups can have depth.
There is a shortcoming with .CreateSelection() approach when reporting shapes which are in a group.
To demonstrate this issue, i prepared a test setup of nested shapes:
On a new page, create two shapes (Sheet.1 and Sheet.2)
(http://666kb.com/i/c4cl872ln2fssn9y2.png)
Group the two shapes to create Sheet.3
(http://666kb.com/i/c4clkeq78i0sqysd6.gif)
Create another shape next to the group (Sheet.4)
(http://666kb.com/i/c4clld6f0lbinapei.png)
Group the group shape and the newly created shape to create Sheet.5
(http://666kb.com/i/c4cln69pl5qxrvore.gif)
The structure of this shape is:
Sheet.5 is parent of Sheet.3 and Sheet.4
Sheet.3 is parent of Sheet.1 and Sheet.2
Now, lets assign this shape to a new layer "Layer 1". Visio will assign Sheet.5 to Layer 1 and all its sub-shapes. That is Sheet.5, Sheet.4, Sheet.3, Sheet.2, and Sheet.1 will all be part of "Layer 1":
(http://666kb.com/i/c4clo443l857oot96.gif)
Lets sub-select the group shape under the main shape (i.e. Sheet.3) and remove the layer assignment for this shape. Note that Visio will remove the layer assignment for the sub-shapes as well. That is, Sheet.3, Sheet.2, and Sheet.1 will be part of no layer.
(http://666kb.com/i/c4cloa543n9rwglqy.jpg)
Lets go one level deeper and sub-select Sheet.1 and assign it to "Layer 1".
(http://666kb.com/i/c4clqjw5rv224kwm2.gif)
With the above arrangements, we have:
Sheet.5 --> Layer 1
Sheet.4 --> Layer 1
Sheet.3 --> *none*
Sheet.2 --> *none*
Sheet.1 --> Layer 1
Now if we use something like:
Sub TestGetShapesInLayer_v1()
Dim vsoSelection as Selection
Set vsoSelection = ActivePage.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, ActivePage.Layers(1))
Dim vsoShape as Shape
For each vsoShape In vsoSelection
Debug.Print vsoShape.Name
Next
End Sub
Then we will not get the correct result; because only Sheet.5 will be reported! Sheet.4 and Sheet.3 are not reported.
Changing the second argument, IterationMode, to different values does not help either:
using visSelModeOnlySub will report no shape at all
using visSelModeOnlySuper will report no shape at all
using visSelModeSkipSub will report Sheet.5 only
using visSelModeSkipSuper will report Sheet.5 only
We can get correct shapes which are member of a layer if we check individual shapes (and sub-shapes recursively).
Here is the code:
Sub TestGetShapesInLayer_v2()
Dim colShapes As Collection
Set colShapes = GetShapesInLayer(ActivePage.Layers(1))
Dim vsoShape As Shape
For Each vsoShape In colShapes
Debug.Print vsoShape.Name
Next
End Sub
Public Function GetShapesInLayer(lyr As Visio.Layer) As Collection
' Abstract: Get the shapes which are member of a layer.
' Parameters:
' * lyr: the layer which need to be processed.
' Immediate: Call PrintVisioObjects(GetShapesInLayer(ActivePage.Layers(1)))
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// colShpResult to collect result
Dim colShpResult As Collection, shp As Visio.Shape
Set colShpResult = New Collection
'// do few checks first
If lyr Is Nothing Then GoTo PROCEDURE_END
'// colshp to get all shapes in lyr
Dim colShp As Collection
'// check lyr is in a Master object
If Not lyr.Master Is Nothing Then
'// get all shapes in master
Set colShp = GetShapesInShape(lyr.Master.PageSheet, -1)
'// else; check lyr is in a Page object
ElseIf Not lyr.Page Is Nothing Then
'// get all shapes in page
Set colShp = GetShapesInShape(lyr.Page.PageSheet, -1)
End If
'// iterate through all shapes of colShp
For Each shp In colShp
'// iterate through layers of which shp is member of
Dim i As Integer
For i = 1 To shp.LayerCount
'// check any of member layer is same as lyr
If shp.Layer(i) Is lyr Then
'// collect shp
Call colShpResult.Add(shp)
End If
Next i
Next shp
'// reclaim used memory
Set colShp = Nothing
PROCEDURE_END:
'// return whatever been collected
Set GetShapesInLayer = colShpResult
End Function
Public Function GetShapesInShape(shp As Visio.Shape, _
Optional iRecursionDepth As Integer = -1, _
Optional colShpResult As Collection = Nothing _
) As Collection
' Abstract: Get sub-shapes of a shape using depth-first traversal.
' Parameters:
' * shp: the shape which need to be processed.
' * iRecursionDepth: the max depth of sub-shapes to return.
' 0 means count only top level shapes; sub-shapes are ignored.
' -1 means count top level shapes and all sub-shapes.
' * colShpResult: is only used internally by this procedure.
' Immediate: Call PrintVisioObjects(GetShapesInShape(ActiveWindow.Selection(1)))
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// initialize colShpResult if this has not been done already
If colShpResult Is Nothing Then
Set colShpResult = New Collection
End If
'// do few checks first
If shp Is Nothing Then GoTo PROCEDURE_END
'// iterate through sub-shapes of shp
Dim shpSub As Visio.Shape
For Each shpSub In shp.Shapes
'// add shpSub to our result
Call colShpResult.Add(shpSub)
'// check there are children for shpSub and recursion should continue
If shpSub.Shapes.Count > 0 And iRecursionDepth <> 0 Then
'// go recursively to get sub-shapes of shpSub
Call GetShapesInShape(shpSub, iRecursionDepth - 1, colShpResult)
End If
Next shpSub
PROCEDURE_END:
'// return whatever been collected
Set GetShapesInShape = colShpResult
End Function
If we run TestGetShapesInLayer_v2() we will get the correct result:
Sheet.5
Sheet.1
Sheet.4
Although the above arrangement of shapes is not common in Visio documents; but we should know exactly what we will get from .CreateSelection() method.
Attached test document and the VBA code.
Thanks,
Yousuf.
nashwaan
Thank you for such detailed explanation!