オートシェイプの線の単純結合(2)

とりあえず，難しいことは考えずに，複数の図形でもいっぺんにくっつけるように書き直してみました。

結合前の線を描くときに，一定の方向性で描いた場合にのみ使える状態です。

ノードの順番は距離云々でも判断がつかないため，そのへんは仕方ないと考えるしかない気がしています。

しくみをわかって使えば十分いける気はしています。とりあえず自分用としてはここまでかな。

Sub test()

    Dim SShapeRange As ShapeRange: Set SShapeRange = ActiveWindow.Selection.ShapeRange
    Dim TSld As Slide: Set TSld = SShapeRange(1).Parent
    
    Dim SShape() As Shape: ReDim SShape(1 To SShapeRange.Count)
    Dim i As Long, j As Long
    For i = 1 To SShapeRange.Count
        Set SShape(i) = ActiveWindow.Selection.ShapeRange(i)
    Next
    
    Dim NodeCollection As New Collection
    Dim str As String, NodeStr As String
    
    For i = 1 To SShapeRange.Count
        NodeStr = StrFreeform(SShape(i))
        For j = 1 To UBound(Split(NodeStr, vbTab))
            If i <> 1 And j = 1 Then
                str = str & vbTab & Left(Split(NodeStr, vbTab)(j), Len(Split(NodeStr, vbTab)(j)) - 1) & "0"
            Else
                str = str & vbTab & Split(NodeStr, vbTab)(j)
            End If
        Next
    Next
    
    DrawFreeForm str, TSld

End Sub

Function StrFreeform(図形 As Shape) As String
    Dim 各ノード As ShapeNode
    For Each 各ノード In 図形.Nodes
        StrFreeform = StrFreeform & vbTab & CLng(各ノード.Points(1, 1)) & "," & CLng(各ノード.Points(1, 2)) & "," & 各ノード.SegmentType
    Next
End Function

Sub DrawFreeForm(strNode As String, pSlide As Slide)
    Dim i As Long, j As Long, ff As FreeformBuilder, sf As Shape
    Dim NodeValue() As Variant
    ReDim NodeValue(UBound(Split(strNode, vbTab)), 3)
    
    For i = 0 To UBound(Split(strNode, vbTab))
        For j = 0 To UBound(Split(Split(strNode, vbTab)(i), ","))
            NodeValue(i, j) = Split(Split(strNode, vbTab)(i), ",")(j)
        Next
    Next

    Set ff = pSlide.Shapes.BuildFreeform(msoEditingAuto, CLng(NodeValue(1, 0)), CLng(NodeValue(1, 1)))
    For i = 2 To UBound(Split(strNode, vbTab))
        If CLng(NodeValue(i, 2)) = msoSegmentCurve And i <= UBound(Split(strNode, vbTab)) - 2 Then
            ff.AddNodes msoSegmentCurve, msoEditingCorner, NodeValue(i, 0), NodeValue(i, 1), NodeValue(i + 1, 0), NodeValue(i + 1, 1), NodeValue(i + 2, 0), NodeValue(i + 2, 1)
            i = i + 2
        Else
            ff.AddNodes msoSegmentLine, msoEditingAuto, NodeValue(i, 0), NodeValue(i, 1)
        End If
    Next
    Set sf = ff.ConvertToShape
End Sub

実行後下の図形ができます。

以上。