Selecting objects based on unique entry in shape data (Prop.shapeKey)

[miless2111s]

I would like to be able to loop through a set of shapes that have the prop.shapekey name in the format 1- and 2- then 3- etc.  When the shape is selected I would like to send it to the back and then loop onto the next one.   

Is this possible and if so how?

Many thanks

Miles

[Paul Herber]

You need to loop through all shapes on the page, for each shape check whether the shape data entry exists, if it does then check the data contents.

[wapperdude]

In addition, if the shapes in question might be nested, i.e., subshapes, then your search needs to be recursive to work thru the nesting structure.

[miless2111s]

Wow, that could take some time!   I have a few thousand shapes on the page and i am targeting 300 x3 of them (1- to 300-, 1BL to 300BL and 1-p to 300-p)  I will have to see how slow this runs!
Are there any tricks you can suggest to speed up Visio code? One that springs to mind is to cut out of the loop as soon as a match is found.
Thanks for the confirmation and any further hints you have
Miles

[wapperdude]

Might not be too bad, but a lot of shapes means a lot of checking, and then a lot of whatever needs to be done with each catch.  Still, better than doing this manually.

You might speed up the process by quickly condensing the number of candidate shapes with filtering.  For example, have the code ignore 1D shapes.
Also, it you edit shapes on the document stencil, those will flush into respective shapes on the drawing page.

[wapperdude]

Attached is sample file using code to search the document sheet for Rectangle masters and then changes their color.  Only the one, correct master is actually processed.  The changes are automatically flushed into the numerous Rectangle shapes placed on the drawing page.

Open the code window and the then use <f8> to step thru the macro.  The code skips the majority of the shapes and only makes processes the desired shapes, saving execution time.

[miless2111s]

Attached is sample file using code to search the document sheet for Rectangle masters and then changes their color.  Only the one, correct master is actually processed.  The changes are automatically flushed into the numerous Rectangle shapes placed on the drawing page.

Open the code window and the then use <f8> to step thru the macro.  The code skips the majority of the shapes and only makes processes the desired shapes, saving execution time.

OK, allow me to check my understanding and the possible implications for what I am trying to do.   Your code:
* makes a new stencil of masters which are on the page
* Cycles through these checking if the name = rectangle
* Changes the master colour for "rectange"
* closes the new stencil
And the change is pushed out to all shapes which are based on the master by the nature of the master / shape relationship.

This would be very useful if I was making changes to the shapes as I could arrange for all shapes on a "layer" (I know they're not "on" a layer but it is easier to say it!:) ) to have the same master and then changes would be quick and easy to make.  I don't understand how this would help me to shorten the task of searching for ShapeRef= "1-" for instance amongst all the shapes on the page.  I can arrange for all shapes which will have ShapeRef of 1- or 2- or 300- to have the same master but does this help in the task of finding 1- on the page?

[Croc]

You can also split the process into two steps:
1 - create a sorted collection and save it in the document.
2 - search for a shape in a sorted collection.
Step 1 will take a long time, but rarely. For example, using a separate "Refresh List" macro.
Step 2 will be performed frequently and quickly. Searching a sorted collection is much faster than checking all shapes on a page or document.
The sorted collection can be saved in the "Data1" field as a delimited list or in SolutionXML.

[miless2111s]

You can also split the process into two steps:
1 - create a sorted collection and save it in the document.
2 - search for a shape in a sorted collection.
Step 1 will take a long time, but rarely. For example, using a separate "Refresh List" macro.
Step 2 will be performed frequently and quickly. Searching a sorted collection is much faster than checking all shapes on a page or document.
The sorted collection can be saved in the "Data1" field as a delimited list or in SolutionXML.

I don't know about collections.  Does the "saved collection" survive the file being closed and re-opened or is the lifespan of the collection as long as the file is open?   When you search for the item in the sorted collection I assume you are finding the actual item so that it can be selected and sent to the back etc?
Also do collections need any settings etc to be enabled on the users' machine?
Many thanks
Miles

[miless2111s]

Currently, my brute force and ignorance solution which cycles through 1.5K - 2K shapes 300 times to identify the things that need to be selected and then sent to the back in a sequence is shown below.  This takes 1.5-2 minutes which I would love to speed up.

Code Select Expand

Sub ReOrder_including_within_layer()

    Dim shp As Visio.Shape
    Dim ShapeKey As String
   
    Application.ScreenUpdating = False
    Application.DeferRecalc = True
    ActiveWindow.DeselectAll
   
    For N = 300 To 1 Step -1
        For Each shp In ActivePage.Shapes
            If shp.CellExistsU("Prop.ShapeKey", 0) Then ShapeKey = shp.Cells("Prop.ShapeKey").ResultStr("")
            If ShapeKey = N & "-" Or ShapeKey = N & "--p" Or ShapeKey = N & "--b" Or ShapeKey = N & "--R" Or ShapeKey = "BL_link-" & N Then
                ActiveWindow.Select shp, visSelect
            End If
         Next shp
            If ActiveWindow.Selection.Count <> 0 Then
                ActiveWindow.Selection.SendToBack
                ActiveWindow.DeselectAll
            End If
    Next N
    ActiveWindow.DeselectAll

'Call ReOrder_Layers

   
Finalise:
    ActiveWindow.DeselectAll
    Application.ScreenUpdating = True
    Application.DeferRecalc = False
End Sub

[wapperdude]

Adding 1 more IF statement might help, if (pun intended) your pages have connector and/or lines, that is, OneD shapes.  The new IF statement immediately excludes these shapes from additional processing.

Code Select Expand


    For N = 300 To 1 Step -1
        For Each shp In ActivePage.Shapes
            If Not shp.OneD Then
                If shp.CellExistsU("Prop.ShapeKey", 0) Then ShapeKey = shp.Cells("Prop.ShapeKey").ResultStr("")
                If ShapeKey = N & "-" Or ShapeKey = N & "--p" Or ShapeKey = N & "--b" Or ShapeKey = N & "--R" Or ShapeKey = "BL_link-" & N Then
                    ActiveWindow.Select shp, visSelect
                 End If
            End If
        Next shp
        If ActiveWindow.Selection.Count <> 0 Then
            ActiveWindow.Selection.SendToBack
            ActiveWindow.DeselectAll
        End If
    Next N



[wapperdude]

Currently, my brute force and ignorance solution which cycles through 1.5K - 2K shapes 300 times to identify the things that need to be selected and then sent to the back in a sequence is shown below.  This takes 1.5-2 minutes which I would love to speed up.
[/quote

In Reply #9, do you have a copy/paste error in the code, specifically this line:  If shp.CellExistsU("Prop.ShapeKey", 0) Then ShapeKey = shp.Cells("Prop.ShapeKey").ResultStr("")

Seems odd.  Didn't test correctly.  Ignoring my OneD IF construct, and some abbreviations, I believe you intended it to read as follows:

Code Select Expand


        For Each shp In ActivePage.Shapes
            If Not shp.OneD Then                                                     'ignore 1D shapes
                If shp.CellExistsU("Prop.Key", 0) Then                        'ignore shapes lacking Prop.Key, I abbreviated your entry for my testing
                    ShapeKey = shp.Cells("Prop.Key").ResultStr("")
                    If ShapeKey = N & "-" Or ShapeKey = N & "--p" Or ShapeKey = N & "--b" Or ShapeKey = N & "--R" Or ShapeKey = "BL_link-" & N Then
                        ActiveWindow.Select shp, visSelect
                    End If
                End If
            End If
        Next shp

        If ActiveWindow.Selection.Count <> 0 Then
            ActiveWindow.Selection.SendToBack
            ActiveWindow.DeselectAll
        End If



[Croc]

I don't know about collections.  Does the "saved collection" survive the file being closed and re-opened or is the lifespan of the collection as long as the file is open?   When you search for the item in the sorted collection I assume you are finding the actual item so that it can be selected and sent to the back etc?
Also do collections need any settings etc to be enabled on the users' machine?

Here is an example of saving a list of target shapes in the Date1 field. If the number of target shapes is significantly less than the number of all shapes, then such a technique can give a gain in terms of the execution time of the work operation.
The Date1 field belongs to the document and is saved with it.
The example contains an unsorted collection. Sorting is optional but can sometimes provide an added benefit.

Code Select Expand

Dim c As Collection

Public Sub RefreshData1()  'Executed once
    Set c = New Collection
    For Each shp In ActivePage.Shapes
        'There must be some filter (If Prop. exists etc)
        c.Add shp.NameID
    Next
    Call CollectionToData1
    ' Now ActiveDocument.DocumentSheet.Data1 contains only the NameId list of target shapes
End Sub

Public Sub WorkOperation()  'Executed multiple times
    Call CollectionFromData1
    For Each itm In c   'NameId of target shapes only
        Debug.Print ActivePage.Shapes(itm).NameID
    Next
End Sub

Private Sub CollectionToData1()
    s = ""
    For Each itm In c
        s = s & itm & ";"
    Next
    ActiveDocument.DocumentSheet.Data1 = s
End Sub

Private Sub CollectionFromData1()
    s = ActiveDocument.DocumentSheet.Data1
    Set c = New Collection
    Arr = Split(s, ";")
    For i = LBound(Arr) To UBound(Arr) - 1
        c.Add Arr(i)
    Next
End Sub

[miless2111s]

Here is an example of saving a list of target shapes in the Date1 field. If the number of target shapes is significantly less than the number of all shapes, then such a technique can give a gain in terms of the execution time of the work operation.
The Date1 field belongs to the document and is saved with it.
The example contains an unsorted collection. Sorting is optional but can sometimes provide an added benefit.

Croc, thank you for the example and explanation.  I sounds like this might be a very useful approach.  Am I right in thinking that I would use the structure of "Sub WorkOperation()" and replace "For Each shp In ActivePage.Shapes" in my code with your "For Each itm In c "  and this will find each specific shape in C, test it to see if it contains "1-" or "1--p" etc and then execute the code rather faster as it is looking through a rather smaller set (1500 items rather than thousands) 300 times?

many thanks

Miles

[Croc]

Yes, you got the idea right.