PROSAGA码农传奇-visio-无法在Visio VBA组中粘合成型

<div class =“post-text”itemprop =“text”>
  
    啊，@ Surrogate打败了我:)但是因为我已经开始写了...除了他的答案，这很好地展示了如何调整内置的动态连接器这里是你的团队寻找方法+自定义连接器。
  
  
    代码假定了一些事情：
  
  <OL>
    <LI>
      已删除两个2D形状的页面
    </LI>
    <LI>
      其中一个形状是包含具有正确形状数据的子形状的组形状
    </LI>
    <LI>
      一个名为“MyConn”的自定义主机，它是简单的1D线，没有其他修改
    </LI>
  </醇>
  
    <a href="https://i.stack.imgur.com/DqRlf.png" rel="nofollow noreferrer">
      <img src =“https://i.stack.imgur.com/DqRlf.png”alt =“在此处输入图片说明”/>
    </A>
  
   <pre>
 <code>
 Public Sub TestConnect()
Dim shp As Visio.Shape 'connector
Dim src As Visio.Shape 'connect this
Dim aim As Visio.Shape 'to this

Dim vPag As Visio.Page
Set vPag = ActivePage

Set shp = vPag.Drop(ActiveDocument.Masters("MyConn"), 1, 1)
shp.CellsU("ObjType").FormulaU = 2
Set src = vPag.Shapes(1)

Set aim = getShape(7, "Prop.ID")

If Not aim Is Nothing Then
    shp.CellsU("BeginX").GlueTo src.CellsU("PinX")
    shp.CellsU("EndX").GlueTo aim.CellsU("PinX")
End If

End Sub

Function getShape(id As Integer, propName As String) As Shape
        Dim shp As Shape
        Dim subshp As Shape
        For Each shp In ActivePage.Shapes
            If shp.Type = 2 Then
                For Each subshp In shp.Shapes
                    If subshp.CellExistsU(propName, 0) Then
                        If subshp.CellsU(propName).ResultIU = id Then
                            Set getShape = subshp
                            Exit For
                        End If
                    End If
                Next subshp
            End If

If shp.CellExistsU(propName, 0) Then
                If shp.CellsU(propName).ResultIU = id Then
                    Set getShape = shp
                    Exit For
                End If
            End If
        Next
    End Function

</code>
 </pre>
  
    请注意，如果你
    <a href="https://msdn.microsoft.com/en-us/vba/visio-vba/articles/cell-glueto-method-visio" rel="nofollow noreferrer">
      阅读文档
    </A>
     对于
     <code>
 Cell.GlueTo
 </code>
    ，你会看到这个项目：
  
  <BLOCKQUOTE>
    
      2-D形状的针脚（创建动态胶水）：
      的
        形状被胶合
  从必须是可路由的（ObjType包括visLOFlagsRoutable）
      </强>
       或者有一个
  动态胶水类型（GlueType包括visGlueTypeWalking），并且确实如此
  不禁止动态胶水（GlueType不包括
  visGlueTypeNoWalking）。胶合到PinX会产生动态胶水
  水平行走偏好和胶合到PinY创建动态胶水
  具有垂直行走偏好。
    
  </BLOCKQUOTE>
  
    因此我为什么要设置
     <code>
 ObjType
 </code>
     细胞到2（
     <code>
 VisCellVals.visLOFlagsRoutable
 </code>
    ）。通常你会在主实例中设置它，因此不需要那行代码。
  
</DIV>