Selecione todas as formas semelhantes no Microsoft Visio

Question

Como faço para selecionar todas as formas semelhantes em um diagrama? Por exemplo, como seleciono todas as setas ou todos os retângulos?

    

Answer 1

Você pode fazer isso em VBA, presumindo que as setas ou retângulos foram criados usando um estêncil, em vez de apenas desenhado. Este código irá selecionar todas as formas na página ativa, como a forma selecionada (usando o mestre de formas)

Sub SelectSimilarShapesByMaster()
    If ActiveWindow.Selection.Count = 0 Then Exit Sub

    Dim SelShp As Visio.Shape
    Set SelShp = ActiveWindow.Selection(1)

    If SelShp.Master Is Nothing Then Exit Sub
    ActiveWindow.DeselectAll
    Dim CheckShp As Visio.Shape
    For Each CheckShp In ActivePage.Shapes
        If Not CheckShp.Master Is Nothing Then
            If CheckShp.Master = SelShp.Master Then
                ActiveWindow.Select CheckShp, visSelect
            End If
        End If
    Next CheckShp

End Sub

Você também pode mexer com as seções de geometria da folha de formas para ver se eles são retângulos da seguinte forma:

Sub SelectRectangles()
    If ActiveWindow.Selection.Count = 0 Then Exit Sub

    Dim SelShp As Visio.Shape
    Set SelShp = ActiveWindow.Selection(1)

    ActiveWindow.DeselectAll
    Dim CheckShp As Visio.Shape
    For Each CheckShp In ActivePage.Shapes
        If IsRectangle(CheckShp) Then ActiveWindow.Select CheckShp, visSelect
    Next CheckShp

End Sub

Function IsRectangle(TheShape As Visio.Shape) As Boolean
    Dim Width As Double, Height As Double
    Width = TheShape.CellsU("Width")
    Height = TheShape.CellsU("Height")
    Dim Result As Boolean
    Result = (TheShape.RowCount(visSectionFirstComponent) = 6)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 1, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 1, 1).ResultIU() = 0)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 2, 0).ResultIU() = Width And TheShape.CellsSRC(visSectionFirstComponent, 2, 1).ResultIU() = 0)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 3, 0).ResultIU() = Width And TheShape.CellsSRC(visSectionFirstComponent, 3, 1).ResultIU() = Height)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 4, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 4, 1).ResultIU() = Height)
    Result = (Result And TheShape.CellsSRC(visSectionFirstComponent, 5, 0).ResultIU() = 0 And TheShape.CellsSRC(visSectionFirstComponent, 5, 1).ResultIU() = 0)
    IsRectangle = Result
End Function

Espero que pelo menos você comece ...