Выбрать все похожие фигуры в Microsoft Visio

Question

Как выбрать все похожие фигуры на диаграмме? Например, как мне выбрать все стрелки или все прямоугольники?

Answer 1

Вы можете сделать это в VBA, предполагая, что стрелки или прямоугольники были созданы с использованием трафарета, а не просто нарисованы. Этот код будет выбирать все фигуры на активной странице, такие как выбранная фигура (используя мастер фигур)

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

Вы также можете поэкспериментировать с просмотром геометрических разделов формы, чтобы увидеть, являются ли они прямоугольниками, например:

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

Надеюсь, это, по крайней мере, поможет вам начать ...