AutoCAD VBAの最近のブログ記事

2010年、明けました。今年の抱負。

ついに2010年です。未だに宇宙旅行は実現されていないのですね。

そんな訳で、今頃となりましたが、明けましておめでとうございます。

今年はニュース系の話題は少し控え目にして、本来のプログラミングの方の記事を細々と書いていこうと思います。初心者なので参考にならないとは思いますがお付き合い下さい。

宜しくお願い致します。

別にこんなマクロを組まなくても、標準の操作で「レイアウトのタブを右クリック→名前変更」で可能な上、非アクティブレイアウトに対しても可能なのですが・・・、一応習作ということで(汗

今回初めて使ったのは、

  • InputBox関数 (VBA)
  • Layoutオブジェクト

です。AcadEntity以外のオブジェクトつまりAcadObjectを扱ったのは初めてです。なので、最初コーディングしているときに、

Dim objLayout As AcadObject

なんて書いてみたのですが、動かしてみたら、objLayouts使ってないじゃない、みたいな感じで・・・。とりあえずアクティブレイアウトだけをいじる場合は要らないようですね。Layoutsコレクションから呼び出す場合には使いそうです。

Option Explicit

Public Sub LRENAM()

    Dim strSheetName As String
    
    On Error GoTo errsub
    
    strSheetName = InputBox("レイアウト名?")
    
    ThisDrawing.PaperSpace.Layout.Name = strSheetName

    Exit Sub
    
errsub:

    MsgBox ("そのレイアウト名は既に使われているか、" & vbCrLf & _
            "レイアウト名が32文字を超えているか、" & vbCrLf & _
            "名前に使えない文字が入っているか、" & vbCrLf & _
            "またはその他のエラーです。")
           
    Err.Clear

End Sub

実際のところ、どうしてこのマクロを組んだかというと、大量のファイル(と言っても20個ほどですが)の末尾のレイアウトをコピーした上で全て同じレイアウト名にする必要があったからです。ですので、実際に使ったのはInputBox関数ではなくて固定の文字列です。

レイアウトのコピーや複数ファイルの扱いなども出来れば良かったのですが、一度に色々は分からないし、本来の仕事もしなくてはいけませんから。今後の課題にしたいと思います。

AutoCADで図面を書くとき、基本的にモデル空間では原寸で描きレイアウトで縮尺を持たせることが多いですが、概要図などでノンスケールの図面を書くことも多いと思います。こんな時、寸法も実寸の寸法値ではなく、「寸法値上書き」で対応することと思いますが、これ、毎回寸法を選択してオブジェクトプロパティ管理から「寸法値上書き」の部分を選んで書き込む、という手作業が非常に面倒くさいです。まあ一つ二つなら良いんですが複数あると面倒くさく感じてきます。画面サイズが1280×1024の場合、オブジェクトプロパティ管理で1スクロールさせないと出てきませんから。

ということで、VBAで連続で出来るようにマクロを組んでみました。

使用するのは、寸法オブジェクトの「TextOverrideプロパティ」です。これを書き換えるだけという至って単純なものです。ただし、寸法オブジェクトもいろいろあるので全てに対応するように工夫してみました。

VBAの「InStr関数」を使って、取得したAcadEntity.ObjectNameに「Dimension」が含まれている場合、に処理をするという感じです。

  • 距離寸法(回転):AcDbRotatedDimension
  • 距離寸法(平行):AcDbAlignedDimension
  • 弧長寸法:AcDbArcDimension
  • 角度寸法:AcDb3PointAngularDimension
  • 角度寸法:AcDb2LineAngularDimension
  • 半径寸法:AcDbRadialDimension
  • 半径寸法:AcDbRadialDimensionLarge(大きな円・円弧の場合)
  • 直径寸法:AcDbDiametricDimension
  • 座標寸法:AcDbOrdinateDimension

また、上書きする文字列は「GetStringメソッド」でその都度キーボードから入力とし、Nullを入力できるように「InitializeUserInputメソッド」に 128 を与えています。

Option Explicit

Public Sub DimTextOverride()

start:

    Dim ReturnObject As AcadEntity
    Dim BasePoint As Variant
    Dim strRetObjName As String
    Dim Hantei As Long
    
    Dim strOverride As String
    
    ' エラー処理
    On Error GoTo ersub
    
main:
    
    ' オブジェクトの選択:GetEntityメソッド
    ThisDrawing.Utility.GetEntity ReturnObject, BasePoint, _
        "寸法を選択して下さい / Cancel=ESC"
    
    ' 選択オブジェクトが「寸法」なら処理
    strRetObjName = ReturnObject.ObjectName
    Hantei = InStr(1, strRetObjName, "Dimension", 1)
    If Hantei > 0 Then
            
        ' 文字列をキーボードから入力
        Call ThisDrawing.Utility.InitializeUserInput(128)
        strOverride = ThisDrawing.Utility.GetString(True, _
                                        "上書きする文字列を入力:")
    
        ' 上書き値をTextOverrideプロパティにセット
        ReturnObject.TextOverride = strOverride
            
        ' オブジェクトを更新
        ReturnObject.Update
                        
        ' 選択に戻る
        GoTo main
            
    Else
            
        ' エラー処理:寸法じゃなかったら警告を出して線分選択に戻る
        MsgBox "これは寸法ではありません。選択し直して下さい。"
            
        GoTo main
            
    End If
        
Exit Sub
    
ersub:
    
    ' エラー処理
    Err.Clear
    
    ThisDrawing.Utility.Prompt "コマンドを終了します。"

End Sub

いつものように、アイコンを作ってボタンに登録してしまいましょう。これまた便利になりました。

 

---閑話休題

 

そういえば以前、「文字列を動かさずに基点変更したい」と申していましたが、これって実は標準のコマンドにあったんですね。「JUSTIFYTEXTコマンド(文字位置合わせ)」です。AutoCAD2002から標準で組み込まれています。何かを検索していて以下のブログさんのところで知りました。アイコンは文字ツールバーの中に入っています。

★文字の配置をかえずに、位置あわせのみを変更する方法 (ふるかわっちの便利なAutoCAD手帳。,2006.6.16)

  • オブジェクトプロパティ管理の「位置合わせ」を変更→『現在設定されている基点の座標』が不変
  • 「JUSTIFYTEXTコマンド」を使って基点を変更→『文字列の見た目の位置』が不変(基点の座標が変わる)

 

およそ言語というものは、しばらく使ってないと忘れてしまうもので、日本人だから日本語は忘れないけど、英語やらドイツ語やらはどんどん忘れていくのですね。プログラミング言語も似たようなもので、しばらく使ってないと忘れてしまったりするのです。

そんなわけで、リハビリも兼ねて一つAutoCAD VBAのマクロを組んでみました。

お題は「連続距離計算」です。通常の距離計算ですと、アイコンをクリックするかdistと入力、マウスで1点目、2点目を選択すると結果が得られるものです。連続してやると毎回1点目、2点目と選ばなくてはいけないので面倒くさいなと。

点を選択するのはGetPointメソッドです。選択可能な点数は暫定で1000点まで。マクロ中に明示的に指定しています。Longなのでもっと増やせると思いますが、1000点選ぶ人がいるとは思えないですね。

n個目の点を選ぶところでやめたくなったらどう処理しようと(頭の中で)探っていたんですが、ESCキーを押すとエラー(No.18)が出ることを利用して別ルーチンに飛ばして処理しました。本当は良くないんでしょうけど、とりあえず目的は達成できてるのでよしとします。(というか、割り込み処理をどうやればいいのかを勉強しなくては・・・)

Option Explicit

Public Sub CDIST()

Main:

    ' ----- Continuous DIST for 2D : 連続距離計算 -----
    '
    '
    '
    ' 点の取得の時にESCを押すとエラーが出るのを利用して
    ' トータル距離を表示している
    
    On Error GoTo ErrorHundle

    Const num As Long = 1000 'とりあえず1000点まで対応
    Dim n As Long
    Dim valPt(1 To num) As Variant
    Dim dblLength As Double
    Dim dblTotalLength As Double
    Dim strLength As String
    Dim strTotalLength As String
        
    ' 値の初期化
    dblLength = 0
    dblTotalLength = 0
        
    ' 1点目の取得
    valPt(1) = ThisDrawing.Utility.GetPoint(, "1点目")

    ' 2点目以降の取得
    For n = 2 To num

        valPt(n) = ThisDrawing.Utility.GetPoint(, n & "点目")
        
        ' 点間距離の計算とStringフォーマットへの変換
        dblLength = Sqr((valPt(n)(0) - valPt(n - 1)(0)) ^ 2 _
                            + (valPt(n)(1) - valPt(n - 1)(1)) ^ 2)
        strLength = Format(dblLength, "##0.0000")
    
        ' プロンプトに表示
        ThisDrawing.Utility.Prompt _
            ("Length=" & strLength & vbCrLf)
    
        ' トータル距離を加算
        dblTotalLength = dblTotalLength + dblLength
        
    Next

    Exit Sub
    
ErrorHundle:
    
    'MsgBox (Err.Number & "番のエラー発生")
    
    ' エラーをクリア
    Err.Clear
    
    ' トータル距離をStringフォーマットへ変換してプロンプトに表示
    strTotalLength = Format(dblTotalLength, "##0.0000")
    ThisDrawing.Utility.Prompt _
        ("Total Length=" & strTotalLength & vbCrLf)

End Sub

 

[ 追記 (2009.7.17) ]

通常の距離計算(Dist)では1点目から2点目を選ぶときにラインが引かれますが、このマクロでも同様のことが出来ました。

GetPointメソッドの第一引数を一つ前の点に設定するだけです。

        valPt(n) = ThisDrawing.Utility.GetPoint(valPt(n - 1), n & "点目")

 

[AutoCAD VBA] 整数型と長整数型

少し前のエントリーで、「ラスターイメージをオン/オフするマクロ」を作りましたが、今日ある図面で動かしたらラスター表示が消えませんでした。あれれ?と思い、ステップインで実行してみたところ、

' 選択セット内のオブジェクト数を取得
IntCnt = SentakuSet.Count

この処理の箇所でエラーに飛んでいるようです。エラーの種別も分からないため、エラー用サブルーチンに MsgBoxでエラーナンバーを表示させてみました。すると、エラーナンバー 6 、つまりOverflowということがわかりました。そこでピンと来ました。

上のコードから分かるとおり、オブジェクト数を整数型( Integer )で定義していました。整数型で扱える範囲は -32,767~+32,767までです。つまり、CAD図面上のオブジェクト数がこれを上回っていることでオーバーフローが発生しているわけです。

したがって、これを長整数型( Long )に設定することで回避できると判断しました。Long型で扱える範囲は -2,147,483,647~+2,147,483,647 です。

元のソースの intCnt と For~Nextで使う n を Integer型からLong型に変更して実行するとエラー無く動きました。(念のため、IntCntをLngCntと変更しました)

 

 

野望に向けて始めの一歩を踏み出すべく、ちょっと調べてみました。

クリックで画像拡大
(クリックで画像拡大します)

いくつか分からないところもあるのですが・・・。

そういえば、ツール→オプションの「印刷とパブリッシュ」の設定もありますね。
あとで調べてみようと思います。

これが将来どう役立つのかは今は不明ですが、備忘録としてエントリーしておこうと思います。

以前紹介した海外のブログ「Through the Interface」さんのRSSフィードをたまに読んでいるのですが、興味深い話題がありましたので紹介します。

DevTV: AutoCAD VBA to .NET Migration Basics (Through the Interface, 2009.4.21)

As mentioned in a comment on a recent post, Stephen Preston, our DevTech Americas Manager, has put together a useful tool and accompanying DevTV session to help people migrate their VBA code to VB.NET. The resultant code uses COM Interop to call into AutoCAD.

VBAプロジェクトをVB6プロジェクトに変換するプログラムというのがあるというのは少し前から知っていました(使い方が分からなかったですけど(汗))。この記事では、VBAプロジェクトをVB.NETプロジェクトに変換するという話題について書かれています。また、DevTVの解説ムービーファイル(のzip)や実際のVB.NETプロジェクト(のzip)なども掲載されています。

なお、ムービーはオンラインでも以下のアドレスから見られるようです。

http://download.autodesk.com/media/adn/VBA_Migration/DevTV_Recording/VBA_Migration.html


会計検査対策等でしばらく忙しい日が続いています。

最近作ったのは、Lineオブジェクトを連続で選択していって合計延長を出すマクロくらいです。今までに作ったものを流用できたので15分ほどで作れてしまいました。結構習熟してきたかも・・・(汗
その次にポイントを次々に選択していって合計延長を出すマクロを作りたいんですが、多忙のためにしばし断念しています。会検明けには取りかかれるでしょうか。



さて、日本のAmazonの洋書コーナーに1点在庫があったのでポチってしまいました。USに比べると随分と高いんですが・・・

ac06vba01.jpgまだ届いたばかりなので中身をじっくり見ていませんが、WindowsAPIを使うとか、他のApplicationへの接続方法とかが書いていて参考になりそうな気がします・・・。

これ買った後、ついカッとなって、Amazon.USで「VB.NET Programing for AutoCAD Customize Level1」をポチってしまいました。USからのインポートは初めてなので到着するか不安ですが、たぶん船便。3~5週間後に来るはずです。

実は結構楽しみです。

マクロの発想は仕事の中から生まれることが多いのですが、今回も正にそうでした。

系統図を作成していて背景が1/2500のラスターイメージです。色は8か254あたりに設定していますので全く見づらいという訳ではないです。ただ、やはり細かいところで見づらい部分が出てきます。それで表示をオフにするのですが、今度は背景ラスターを確認したくなります。そのたびにラスター枠を選んで表示プロパティを切り替えるという作業が発生します。拡大していたりするとラスター枠が見えるまで縮小してから選択したりと単純なようで意外に面倒な作業です。また、あらかじめ、「修正」→「オブジェクト」→「イメージ」→「フレーム」→「1」と選んで境界枠が表示されるようにしておかなくてはいけません(これをしておかないと、クイック選択に頼らないといけなくなります)。

そこで、ツールバーのアイコンをクリックしたらラスター表示をオン/オフできるようなマクロを組むことにしました。


■ §1. 基本的な仕組みで理解する

今回のマクロは簡素化すると以下のような流れとなります。

図面内のラスターイメージオブジェクトを取得

ImageVisibilityプロパティを取得

TrueだったらFalseに、FalseだったらTrueにする

※注意:VisibleプロパティではなくImageVisibilityプロパティになります。

はじめVisibleプロパティをFalseにしてしまい、画面から全く見えなくなって焦りました(汗) それでRasterオブジェクトのヘルプを見直したところ、ImageVisibilityプロパティを発見したというわけです。


■ §2. オブジェクトの取得ってどうやるの?

今まで作ってきたマクロでは、図形オブジェクトの取得をGetEntityメソッドでクリックして選んだり、選択セットを作成した上でSelectOnScreenで選択または範囲選択して取得していました。
これに対して、今回のマクロではマクロを起動したら勝手に取得してくれなければなりません。ここのところの処理を考えるのに一番苦労しました。

愛用している開発者用ヘルプの「AutoCAD VBA/ActiveXレファレンス」から、「Selectなんとか」や「Getなんとか」というメソッドがないか、「取得」「オブジェクト,追加」というキーワードなどで探しました。一通り見ましたが、「ある特定のオブジェクトを取得するメソッド」という都合の良いものはやはりありませんでした(笑)

繰り返しますが、ポイントは「手を動かさずに取得する」ことです。そして見つけたのが、SelectionSetオブジェクトからリンクされたSelectメソッドです。

Selectメソッド:オブジェクトを選択し、それを選択セットに配置する

構文
object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]

    object : SelectionSet
    Mode : acSelectionSetAll = すべてのオブジェクトを選択する


これによって図面内の全てのオブジェクトを選択セットに取得することが出来ました。


■ §3. 選択セットからラスターオブジェクトだけ抜き出すには?

図面内の全てのオブジェクトが選択セットに配置されました。それなら選択セット内からラスターイメージだけを抜き出せばいいのではないか、と考えました。

更に調べていくと、Itemメソッドというのが使えそうでした。

Itemメソッド:コレクション、グループ、または選択セット内の指定された
              インデックスにしたがって、メンバー オブジェクトを取得します。

構文
Set RetObject = object.Item(Index)

    object : SelectionSet
    Index : 整数または文字列。整数の場合は0からN-1までとし、この場合 N は
            コレクションまたは選択セット内のオブジェクトの数


この時、N = SelectionSet.Count で取得できますので、For Nextループで処理が可能です。つまり、0~N-1番目のオブジェクトを一つ一つチェックしていき、ラスターイメージなら処理をする、という構造が作れます。

この時の注意点を一つ。但し書きに「このメソッドに対する戻り値のタイプは IAcadObject です。」とあります。そこでまたハテナ? IAcadObjectって何? AcadObjectとどう違うの?ということで前のエントリーに書きました。結局分かってないままなのですが...。


最終的なコードは以下となります。

Option Explicit

Public Sub RasterOnOff()

    ' ラスターの表示をオン/オフするマクロ
    '  ※実行すると即反映されます。
    
    Dim SentakuSet As AcadSelectionSet
    Dim objEnt As IAcadObject
    ' ※Itemメソッドに対する戻り値のタイプは IAcadObject です。
    Dim intCnt As Integer
    Dim n As Integer
    Dim boolTF As Boolean
        
    ' エラー処理
    On Error GoTo ersub
                
    ' 選択セットの追加
    Set SentakuSet = ThisDrawing.SelectionSets.Add("SS15")
    
    ' 選択セットに画面上の全てのオブジェクトを追加
    SentakuSet.Select acSelectionSetAll
    
    ' 選択セット内のオブジェクト数を取得
    intCnt = SentakuSet.Count
    
    ' オブジェクトの数だけループ処理
    For n = 0 To (intCnt - 1)
    
        ' 選択セット内のn番目のオブジェクトを取得
        Set objEnt = SentakuSet.Item(n)
        ' ※Setステートメントが無いとError91になる
        
        ' オブジェクトがラスターなら処理
        If objEnt.ObjectName = "AcDbRasterImage" Then
            boolTF = objEnt.ImageVisibility
        
            ' 処理:ImageVisibilityプロパティ値の変更
            If boolTF = True Then
                objEnt.ImageVisibility = False
                objEnt.Update
                ThisDrawing.Utility.Prompt "ラスターを不可視に _
                                                      変更しました。"
            
            Else
                objEnt.ImageVisibility = True
                objEnt.Update
                ThisDrawing.Utility.Prompt "ラスターを可視に _
                                                      変更しました。"
            
            End If
        End If
    Next
    
    ' 選択セットを削除
    SentakuSet.Delete
    
    Exit Sub
    
ersub:

    ' エラーをクリア
    Err.Clear
    ' 選択セットを削除
    SentakuSet.Delete
    
End Sub


早速ツールバーに登録しました。

これは!!! すごい便利になりました。アイコンをクリックするだけでラスター表示のオンオフが可能に。いやまあそういう様に作ったので当然なのですが、実際使うと非常に便利でした。

このマクロは皆さんにも自信を持ってお薦めできると思います。良かったら試してみて下さい。

 

[ 2009.5.30 02:40 追記 ]

選択セット内のオブジェクト数を取得する場合、整数型(Integer型)では32,768個までしか扱えません。ちょっと大きめの図面ファイルだとオーバーしている可能性が高いです。したがって、長整数型(Long型)に変更して下さい。Long型では2,147,483,648個(約21億個)までのオブジェクトに対応出来ます

次のマクロを作っている途中にヘルプだったかWebだったか忘れたんですが、違いを書いてあるところがありました。再度探してみたけど見つかりません(汗

記憶によると・・・

  • AcadObject型・・・全てのオブジェクト
  • AcadEntity型・・・図形オブジェクト
acad.jpg



らしいです。図形以外のオブジェクトとは、例えばApplicationオブジェクトとかLayerオブジェクトなどだと思います。

これはとりあえず(なんとなく)理解できたのですが、もっと理解できないものが出てきました。

AcadObject型 と IAcadObject型 の違いって何?


検索してもヒット数が少なく、すこし見てみましたが分かりませんでした。

カスタム検索
Access Counter
Powered by Movable Type 4.22-ja

2016年9月

Sun Mon Tue Wed Thu Fri Sat
        1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30