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