Excel VBA，在两个形状之间创建连接器，避免交叉第三个形状

Question

我需要一些 Excel VBA 代码来创建一个连接器来连接两个形状（A 和 C）。

形状 B 位于形状 A 和 C 之间，连接器必须绕过形状 B，而不是穿过它。

有人有什么想法吗？

这是我在两个现有形状之间创建连接器的代码。

Public Function func_CreateConnectors(ByVal strSheetName As String, ByVal strShape1Name As String, ByVal strShape2Name As String, ByVal strConnectorName As String, ByVal dbConnectorWeight As Double)
Dim s1 As Shape, s2 As Shape, connectorShape As Shape
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(strSheetName)

'Get a reference to start and end shape.
Set s1 = ws.Shapes(strShape1Name)
Set s2 = ws.Shapes(strShape2Name)

'Create a connector (position and size don't matter).
Set connectorShape = ws.Shapes.AddConnector(msoConnectorCurve, 1, 1, 1, 1)

'Connect to each shape.
With connectorShape
    .ConnectorFormat.BeginConnect s1, 2
    .ConnectorFormat.EndConnect s2, 2
    .Line.Weight = dbConnectorWeight
    .Name = strConnectorName
    .Line.ForeColor.RGB = RGB(0, 255, 255)
    .RerouteConnections
End With

结束功能

图像显示了所需的结果。

Answer 1

据我所知，没有直接的方法来获取连接器的布线坐标。您可以访问的唯一属性是其宽度、高度以及顶部和左侧坐标。

您可以使用连接器的起点和终点来近似计算连接器的中点，尽管这种方法并不完全准确。

这是一个示例代码片段，用于根据连接器的起点和终点计算中点坐标：

Sub GetConnectorMidPoint()
    Dim ws As Worksheet
    Dim connectorShape As shape
    Dim startX As Double, startY As Double
    Dim endX As Double, endY As Double
    Dim midX As Double, midY As Double
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your sheet name
    Set connectorShape = ws.Shapes("Connector") ' Change to your connector's name

    ' Get the starting point (X, Y)
    startX = connectorShape.ConnectorFormat.BeginConnectedShape.Left + connectorShape.ConnectorFormat.BeginConnectedShape.Width / 2
    startY = connectorShape.ConnectorFormat.BeginConnectedShape.Top + connectorShape.ConnectorFormat.BeginConnectedShape.Height / 2
    
    ' Get the ending point (X, Y)
    endX = connectorShape.ConnectorFormat.EndConnectedShape.Left + connectorShape.ConnectorFormat.EndConnectedShape.Width / 2
    endY = connectorShape.ConnectorFormat.EndConnectedShape.Top + connectorShape.ConnectorFormat.EndConnectedShape.Height / 2
    
    ' Calculate the midpoint
    midX = (startX + endX) / 2
    midY = (startY + endY) / 2
    
    ' Output the coordinates of the midpoint
    Debug.Print "Midpoint X: " & midX
    Debug.Print "Midpoint Y: " & midY
End Sub

Midpoint X: 406.5
Midpoint Y: 159

您可以使用该中点并将其与任何“块形状”的属性进行比较，通过修改

.ConnectorFormat.Parent.Adjustments.Item(1)

属性迭代调整连接器的曲率。然而，这种方法对于精确路由来说可能不太可靠。

如果有更准确、更可靠的方法来实现这一点，我也很有兴趣了解它。