Как выбрать все похожие фигуры на диаграмме? Например, как мне выбрать все стрелки или все прямоугольники?
1 ответ
2
Вы можете сделать это в 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
Надеюсь, это, по крайней мере, поможет вам начать ...