首页 > 解决方案 > Visio VBA - 连接到标注的线路

问题描述

我有一个标注触及 Visio 2013 中的一条线。

我发觉到:

  1. 我在 GluedShapes 中看不到它
  2. 我无法将连接器点添加到线(我认为这会触发 GluedShapes)

这是我用来查找它的代码。

 For Each shp In Visio.ActivePage.Shapes
     conn = shp.Name
     aryTargetIDs = shp.GluedShapes(visGluedShapesAll1D, "")
     For i = 0 To UBound(aryTargetIDs)
         Set targetShape = Visio.ActivePage.Shapes.ItemFromID(aryTargetIDs(i))
         Tgt = targetShape.Text
         Debug.Print "1D glue " & conn & "|" & Tgt
     Next i 
 Next shp

和图纸

任何想法如何找到“连接”?也许试图遍历在标注结束下传播的任何内容..

标签: vbavisio

解决方案


好的,我觉得这有点笨拙,但它似乎是这样做的方法.. 基本上是从SpatialRelationship 属性和选定的形状工作

这是我的代码

Dim intTolerance As Integer
Dim intReturnValue As VisSpatialRelationCodes
Dim intFlag As VisSpatialRelationFlags
Dim strReturn As String
    
Set sel = ActiveWindow.Selection
For Each shp In sel
    conn = shp.Name
    'Initialize tolerance argument.
    intTolerance = 0.25

    'Initialize flags argument.
    intFlag = visSpatialIncludeHidden
    For Each vsoShapeOnPage In ActivePage.Shapes
    
        'Get the spatial relationship.
        intReturnValue = shp.SpatialRelation(vsoShapeOnPage, _
            intTolerance, intFlag)
    
        'Convert return code to string value.
        Select Case intReturnValue
            Case VisSpatialRelationCodes.visSpatialContain
                'strReturn = "Contains"
            Case VisSpatialRelationCodes.visSpatialContainedIn
                'strReturn = "is Contained in"
            Case VisSpatialRelationCodes.visSpatialOverlap
                'strReturn = "overlaps"
            Case VisSpatialRelationCodes.visSpatialTouching
                strReturn = "is touching"
            Case Else
                'strReturn = "has no relation with"
        End Select
       
        'Display relationship in the shape's text.
        vsoShapeOnPage.Text = shp.Name & " " & strReturn & " " & vsoShapeOnPage.Name
    
    Next
    Next shp

End Sub

推荐阅读