メモ‎ > ‎AutoCAD VBA‎ > ‎

フィールドコード VBAサンプル

2010/06/11 15:33 に mura が投稿

掲示板でフィールドコードで調べた面積を、mm2単位から100万分の1にしてm2にする方法をさがしていました。

以前、どっかでプログラムを組んだような気がして、やってみましたけどそのときは別の方法を使っていました。
というわけで、結論はやっぱり無理で・・・検証のための作りかけのVBAだけが残りました。
もったいないのでここに書いて、後から使い回ししよう。
'-------------------------------------------------------------
' -フィールドコード追加サンプルプログラム
' - http://www.mura.sh/
' - (c) mura. 2004  All rights reserved
'-------------------------------------------------------------

Public Sub AddField()
    Dim returnObj As AcadObject
    Dim basePnt As Variant
    Dim acPline As AcadLWPolyline
    Dim acMtext As AcadMText
    Dim strCode As String
    Dim width As Double

RETRY:
    On Error Resume Next
    '面積を調べるポリラインを選択
    ThisDrawing.Utility.GetEntity returnObj, basePnt, vbCr + "ポリラインを選択: "
    
    If Err <> 0 Then
        MsgBox "Program ended." & Err, , "フィールドコード プログラム"
        Err.Clear
        Exit Sub
    Else
        If (returnObj.ObjectName = "AcDbPolyline") Then
            Set acPline = returnObj
            'フィールド式の定義
            strCode = "%<\AcObjProp Object(%<\_ObjId " & acPline.ObjectID & ">%).Area \f ""%.1f ÷1000000が面積"">%"
            'width = 1000
            'フィールド式を入れるマルチテキストの作成位置を指定
            basePnt = ThisDrawing.Utility.GetPoint(, "マルチテキストの左上コーナーを指定: ")
            Set textObj = ThisDrawing.ModelSpace.AddMText(basePnt, width, strCode)
            acMtext.Update
            Exit Sub
        End If
    End If
    
    GoTo RETRY
End Sub

(2004年12月28日)
Comments