ShapeInfo

　CDR X3(DRAW)の第1弾は、MLで話題になったシェイプの面積、ノードが右回りかどうかを表示するマクロです。
　宮本さんのヒントを元に作成しました。
　情報を表示したいシェイプ(曲線化したものに限る。)を選択した状態で実行して下さい。
　実行すると、面積を算出し、シェイプのStaticID、ノード数、面積(mm²単位)、右回りか左回りかをMsgBoxで表示します。

---

Attribute VB_Name = "main"
Option Explicit

Sub main()
' ShapeInfo
' Copyright by Albatross (c)2007
' Ver 1.00 2007/10/08

    Dim du As cdrUnit
    Dim area As Double
    Dim msgt As String
    
    du = ActiveDocument.Unit
    ActiveDocument.Unit = cdrMillimeter
    
    If ActiveDocument Is Nothing Then
        MsgBox "ドキュメントがありません", vbCritical, "Error"
        Exit Sub
    End If
    If Application.ActiveSelection.Shapes.Count <> 1 Then
        MsgBox "ノードが選択されていないか、複数選択されています(a)", vbCritical, "Error"
        Exit Sub
    End If
    If Application.ActiveSelection.Shapes(1).Type <> cdrCurveShape Then
        MsgBox "選択されたノードは曲線のものではありません(b)", vbCritical, "Error"
        Exit Sub
    End If
    area = getArea
    msgt = "ID : " & ActiveShape.StaticID & " / Nodes : " & ActiveShape.Curve.Nodes.Count & " / Area : "
    
    If area < 0 Then
        msgt = msgt & Abs(area) & "mm^2 / 右回り "
    Else
        msgt = msgt & area & "mm^2 / 左回り "
    End If
    
    MsgBox msgt, vbInformation, "Shape Information"

    ActiveDocument.Unit = du
End Sub

Function getArea()
    
    Dim xc As Double, yc As Double
    Dim xp As Double, yp As Double
    Dim shpc As Curve
    Dim sum As Double
    Dim ndsc As Integer, i As Integer
    
    Set shpc = ActiveShape.Curve
    ndsc = shpc.Nodes.Count
    sum = 0
    For i = 1 To ndsc
        shpc.Nodes(i).GetPosition xc, yc
        shpc.Nodes(i).Previous.GetPosition xp, yp
        sum = sum + (xp * yc - xc * yp) / 2
    Next i
    getArea = sum
End Function

---

＜＜戻る