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

时间:2019-05-21 18:55:49

标签: vba visio

我是VBA的新手,这是我的第一个任务,涉及一个预先存在的Visio绘图。

Visio绘图由多个形状组成,我最终想要一种使用vba代码检测电缆(由动态连接器连接的两个“连接器”形状)形状的方法。去做这个, 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?在文档中找到所有形状并将它们存储在数组中的最简单方法是什么?

1 个答案:

答案 0 :(得分:1)

了解所需的业务逻辑是第一步。您的步骤1和2可以很简单。

了解您的解决方案空间就是了解编程语言为您提供的工具范围。在这种情况下,关键在于如何有效地循环(例如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部分中更易于使用,而无需您再次查找和引用这些形状。

如果使用分组形状,则答案会变得更加复杂。如果出现这种情况,我建议参考一个新问题,因为答案将涉及递归并将集合传递到更复杂的一行。