如何在 Visio 绘图中查找所有形状并将每个形状添加到数组中？

Question

我是 VBA 的新手，这是我的第一份作业，涉及预先存在的 Visio 绘图。

Visio 绘图由多个形状组成，我最终想要一种方法来使用 vba 代码检测哪些形状是电缆（两个 "connector" 形状由动态连接器连接）。去做这个， 1) 我想首先将所有形状名称存储在一个数组中。 2) 然后，我想用连接器形状的已知名称交叉检查该数组，并创建一个仅包含这些连接器形状的新数组。 3) 接下来，我将检查每个连接器形状连接到什么，这将使我能够确定它是什么类型的电缆（我已经完成了这部分代码）。 4) 最后，我会将电缆的 # 分配给其中一种连接器形状（我想我也有这方面的工作代码）。

我正在尝试找出如何使用现有代码实现步骤 1 和 2。

目前我只能在选择其中一个形状时检测到连接的形状：

Public Sub ConnectedShapes()
' Get the shapes that are at the other end of
' incoming connections to a selected shape
    Dim vsoShape As Visio.Shape
    Dim allShapes As Visio.Shapes
    Dim lngShapeIDs() As Long
    Dim intCount As Integer

    If ActiveWindow.Selection.Count = 0 Then
        MsgBox ("Please select a shape that has connections.")
        Exit Sub
    Else
        Set vsoShape = ActiveWindow.Selection(1)
    End If

    Set allShapes = ActiveDocument.Pages.Item(1).Shapes
    lngShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")

    Debug.Print "   Shape selected:     ";
    Debug.Print vsoShape

    Debug.Print "   Shape(s) connected: ";
    For intCount = 0 To UBound(lngShapeIDs)
        connectedItem = allShapes.ItemFromID(lngShapeIDs(intCount)).Name
        Debug.Print connectedItem
        If InStr(1, vsoShape, "USB A - top") = 1 Then
            If InStr(1, connectedItem, "USB A Female") = 1 Then
                '    write cable's number
            ElseIf InStr(1, connectedItem, "USB Mini B") = 1 Then
                '    write cable's number
            ElseIf InStr(1, connectedItem, "USB Micro B") = 1 Then
                '    write cable's number
            ElseIf InStr(1, connectedItem, "USB C Male") = 1 Then
                '    write cable's number
            End If
        End If
    Next
End Sub

Visio vba 是否有可帮助我执行步骤 1 和 2 的内置函数？找到文档中的所有形状并将它们存储在数组中的最简单方法是什么？

Answer 1

了解您想要的业务逻辑是第一步。您的步骤 1 和 2 可以是一个步骤。

了解您的解决方案 space 是关于了解编程语言为您提供的工具范围。在这种情况下，它是关于如何有效地循环（例如For Each）和信息容器（例如Collection）。

这是一些示例代码：

Option Explicit ' Always use this at the top of a module. Always.

Function ExampleFindShapes(chosenPage as Page) as Collection
Dim foundShapes as New Collection ' Note the new part, this initialised the Collection
Dim shapeLoopIterator as Shape
Dim arrayLoopIterator as Long
Dim validShapes as Variant

    validShapes = Array("Bob", "Harry", "George")
    For each shapeLoopIterator in chosenPage.Shapes ' One way to loop through an object collection
        For arrayLoopIterator = LBound(validShapes) to UBound(validShapes) ' One way to loop through an array
            If shapeLoopIterator.Name = validShapes(arrayLoopIterator) Then
                foundShapes.Add shapeLoopIterator ' store the found shape as a reference to the shape
                'Could put something in here to break out of the loop
            End If
        Next arrayLoopIterator
    Next shapeLoopIterator
    ExampleFindShapes = foundShapes
End Function

根据内存编码，因为我没有在这台机器上安装 Visio，所以 Page 可能是其他东西。

我存储了对形状的引用而不仅仅是名称，因为找到的形状集合将更容易在您的第 3 部分和第 4 部分中使用，而您不必再次查找和引用形状。

如果您使用的是分组形状，答案会变得有点复杂。如果是这种情况，我建议引用这个问题的新问题，因为答案将涉及递归并将集合传递到更复杂的行。

如何在 Visio 绘图中查找所有形状并将每个形状添加到数组中？

How to find all shapes in a Visio drawing and add each shape to an array?

vba

visio