Bunkatsu

　第三弾は、やはりGraphics MLで話題になったAIのパスファインダーの機能を実現するスクリプトです。パスファインダーにはいろいろな機能があるそうですが、そのうち「分割」という機能を作ってみました。
　やりかたのわかった2つのオブジェクトのケースにのみ対応しています。

---

Attribute VB_Name = "bunkatsu"
Option Explicit

Sub bunkatsu()
    '
    ' Version 1.00 2001/08/21 Albatross
    ' Description:AI bunkatsu
    '
    '
    Dim s1 As Shape, s2 As Shape
    Dim sb1 As Shape, sb2 As Shape
    Dim sb3 As Shape

    If Not isSelected() Then Exit Sub
    
    Set s1 = ActiveSelection.Shapes(1)
    Set s2 = ActiveSelection.Shapes(2)

    ActiveDocument.ClearSelection
    s1.AddToSelection
    Set sb1 = ActiveSelection.Trim(s2, True, True)

    ActiveDocument.ClearSelection
    s2.AddToSelection
    Set sb2 = ActiveSelection.Trim(s1, True, True)

    ActiveDocument.ClearSelection
    s1.AddToSelection
    Set sb3 = ActiveSelection.Intersect(s2, False, False)

    sb1.BreakApart
    sb2.BreakApart
    sb3.BreakApart

End Sub
    
Private Function isSelected()
    Dim r As Boolean
    On Error GoTo ErrHandler
    r = False
    If ActiveDocument Is Nothing Then
        MsgBox "ドキュメントがありません", vbCritical, "Error"
    Else
        If Application.ActiveSelection.Shapes.Count <> 2 Then
            MsgBox "オブジェクトが選択されていないか、選択されたものが2個ではありません", vbCritical, "Error"
        Else
            r = True
        End If
    End If
ExitSub:
    isSelected = r
    Exit Function
ErrHandler:
    r = False
    Resume ExitSub
End Function

---

＜＜戻る