ポリラインの面積を調べる部分を 選択セットに対応させることに。

SelectOnScreenメソッドとフィルタを使うと、処理が一気に楽になります。

エラー処理が必要な気がするけど・・・。

使用した選択セットの削除を確実にする例外処理は、何が良いんだろう？

'------------------------

'ポリラインの面積を調べる(選択セット対応)

'------------------------

Public Sub AreasToText()

    Dim ssPline As AcadSelectionSet

    Dim FilterType(0) As Integer

    Dim FilterData(0) As Variant

    Set ssPline = ThisDrawing.SelectionSets.Add("SSP1")

    'フィルタを定義（閉じている必要があれば追加すること）

    FilterType(0) = 0

    FilterData(0) = "LWPOLYLINE"

    'FilterType(1) = 70

    'FilterData(1) = 1  '1 = 閉じたポリライン

    'ユーザがポリラインを選択

    ssPline.SelectOnScreen FilterType, FilterData

   

    Dim entPline As AcadLWPolyline

    Dim dblArea As Double

    Dim strCode As String

    Dim count As Integer

    '面積を合計

    For Each entPline In ssPline

        dblArea = dblArea + entPline.Area

        count = count + 1

    Next entPline

    '選択セットの処理

    ThisDrawing.SelectionSets.Item("SSP1").Delete

    '面積を表示する文字を作成

    If count > 0 Then

        strCode = Format(dblArea / 1000000, "##,##0.000 ㎡")

        'マルチテキストの作成位置を指定

        Dim basePnt As Variant

        Dim acMtext As AcadMText

        Dim width As Double

        'width = 1000

        basePnt = ThisDrawing.Utility.GetPoint(, "マルチテキストの左上コーナーを指定: ")

        Set acMtext = ThisDrawing.ModelSpace.AddMText(basePnt, width, strCode)

        acMtext.Update

    End If

End Sub

（2005年1月 5日）