指定の位置から検索文字に線を引くマクロ｜AutoCAD VBAマクロの作成方法
今回はAutoCADオープンチャットにて頂いたマクロの案をもとに作成したVBAマクロの解説です。
文字検索をして見つかったテキストに対して、指定の位置から線を一括で引くというマクロです。
マクロ機能
・モデル空間に存在するダイナミックテキストとマルチテキストが検索対象
・ブロック内に存在するテキストは検索対象外
・コード内の引数を変更することで完全一致検索と部分一致検索を行うことが可能
・処理終了後に検索文字と検索結果の個数をメッセージで表示
CADデータ出典
CAD素材.com：https://cad-freed-rawingsamples.com/toilet-detail/
サンプルコード
マクロのサンプルコードは下記のとおりです。コード実行後にプロンプトが表示されますが、「基点」「検索文字」の順で入力することで検索結果のテキストに対して線を引くことができます。
|
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 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
Option Explicit '-------------------------------------------------------------------- '- ﾒｲﾝ処理 '-------------------------------------------------------------------- Sub main() Dim cTexts As Collection Dim vCoord As Variant Dim vCoordText As Variant Dim sKeyword As String Dim oEntity As AcadEntity Dim oLine As AcadLine '基点座標の取得 On Error Resume Next vCoord = ThisDrawing.Utility.GetPoint(Prompt:="基点を選択") If Err.Number <> 0 Then Exit Sub On Error GoTo 0 '検索文字列の取得 On Error Resume Next sKeyword = ThisDrawing.Utility.GetString(1, "検索文字列を入力") If Err.Number <> 0 Then Exit Sub On Error GoTo 0 '指定の文字列を含むﾃｷｽﾄを取得 Set cTexts = FindTexts(sKeyword, False) '取得したﾃｷｽﾄﾙｰﾌﾟ For Each oEntity In cTexts 'ﾃｷｽﾄ基準点の座標取得 vCoordText = oEntity.InsertionPoint '直線作成 (基点 - ﾃｷｽﾄ基準点) Set oLine = ThisDrawing.ModelSpace.AddLine(vCoord, vCoordText) Next '描画更新 Call ThisDrawing.Regen(acAllViewports) Call MsgBox("【 " & sKeyword & " 】 " & cTexts.Count & "個見つかりました。", vbInformation) End Sub '-------------------------------------------------------------------- '- 値が指定の文字列と同じﾓﾃﾞﾙ空間のﾃｷｽﾄをすべて取得する '- sKeyword ：検索文字列 '- (flgIsExactMatch) ：True=完全一致, False=部分一致 '- 戻り値 ：対象ﾃｷｽﾄが格納されたｺﾚｸｼｮﾝ '-------------------------------------------------------------------- Private Function FindTexts(ByVal sKeyword As String, _ Optional flgIsExactMatch As Boolean = True) As Collection Dim cTexts As Collection Dim oEntity As AcadEntity Set cTexts = New Collection 'ﾓﾃﾞﾙ空間内要素ﾙ-ﾌﾟ For Each oEntity In ThisDrawing.ModelSpace 'ﾏﾙﾁﾃｷｽﾄ,ﾀﾞｲﾅﾐｯｸﾃｷｽﾄの場合 If TypeName(oEntity) = "IAcadMText" Or _ TypeName(oEntity) = "IAcadText" Then '完全一致 If flgIsExactMatch = True Then If oEntity.TextString = sKeyword Then Call cTexts.Add(oEntity) End If '部分一致 Else If InStr(oEntity.TextString, sKeyword) <> 0 Then Call cTexts.Add(oEntity) End If End If End If Next Set FindTexts = cTexts End Function |
コード解説
ユーザー入力処理
今回のマクロでは「基点」と「検索文字」をユーザー入力としています。ユーザーがクリックした地点の座標を取得するにはUtilityオブジェクトのGetPointメソッドを、ユーザーが入力した文字列を取得するにはUtilityオブジェクトのGetStringメソッドを利用します。GetPoint/GetStringメソッドは実行されるとユーザー入力待ち状態となり、対話的にユーザーが入力した値を取得することができます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
'基点座標の取得 On Error Resume Next vCoord = ThisDrawing.Utility.GetPoint(Prompt:="基点を選択") If Err.Number <> 0 Then Exit Sub On Error GoTo 0 '検索文字列の取得 On Error Resume Next sKeyword = ThisDrawing.Utility.GetString(1, "検索文字列を入力") If Err.Number <> 0 Then Exit Sub On Error GoTo 0 |
GetPointメソッドは第1引数にユーザー入力時に相対基点となる地点のX,Y,Z座標が入った配列、第2引数にユーザー入力時に表示するメッセージを設定します。これにより、戻り値としてユーザーがクリックした地点の座標を取得することができます。引数はいずれも省略可能のため、サンプルコードでは第1引数は省略して相対基点を設定しないようにしています。
GetStringメソッドは第1引数にスペース(空白文字)を対応するか否かの設定値、第2引数にユーザー入力時に表示するメッセージを設定します。第1引数は「0」を設定すると入力される文字列にスペースを含めることができず、「1」を設定するとスペースを含めることができます。第2引数は省略可能です。これにより、戻り値としてユーザーが入力した文字列を取得することができます。
これらメソッドはユーザーが入力キャンセル([Esc]キーの押下)した場合にエラーが発生してしまうため、「On Error Resume Next」でエラーを無視する等の何らかの対策が必要になります。サンプルコードではエラー無視を行い、エラーが発生したタイミングで処理を終了するようにしています。
指定の文字列を含むテキストを取得
前項で入力された「検索文字」を含むテキスト(ダイナミックテキスト/マルチテキスト)をすべて取得するため、ModelSpace内の要素でループ処理を行います。(※ペーパー空間の場合はPaperSpace)
モデル空間を操作するためのModelSpaceはコレクションであるため、コレクション内ループを行うことでモデル空間内の全要素を取得することができます。このとき取得したオブジェクトのタイプを判定することで、テキストのみに対して特定の処理を行うことができるようになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
'ﾓﾃﾞﾙ空間内要素ﾙ-ﾌﾟ For Each oEntity In ThisDrawing.ModelSpace 'ﾏﾙﾁﾃｷｽﾄ,ﾀﾞｲﾅﾐｯｸﾃｷｽﾄの場合 If TypeName(oEntity) = "IAcadMText" Or _ TypeName(oEntity) = "IAcadText" Then '完全一致 If flgIsExactMatch = True Then If oEntity.TextString = sKeyword Then Call cTexts.Add(oEntity) End If '部分一致 Else If InStr(oEntity.TextString, sKeyword) <> 0 Then Call cTexts.Add(oEntity) End If End If End If Next |
テキストの値はText/MTextオブジェクトのTextStringプロパティを使うことで取得ができます。この値に対してユーザー入力の値が完全一致(もしくは部分一致しているかの判定を行い、一致している場合はコレクションに格納するという処理を行っています。完全一致の判定は単純に値がイコールかを確認するだけで、部分一致判定はInStr関数を使うことで判定ができます。
基点からテキストへの線分作成
基点の座標と線を引く対象のテキストの取得ができたので、線分を作成します。
線分の作成をするにはModelSpaceのAddLineメソッドを使い下記のように記載します。
Set oLine = ThisDrawing.ModelSpace.AddLine(vCoord1, vCoord2)
第1引数は始点のX,Y,Z座標が格納された配列、第2引数は終点のX,Y,Z座標が格納された配列をそれぞれ入力します。これにより線分が作成され、戻り値としてLineオブジェクトが返されます。
サンプルコードでは始点の座標をユーザー入力で取得した基点の座標、終点の座標をテキスト基準点の座標として線分を作成しています。テキスト基準点の座標はInsertionPointプロパティを使うことで配列として取得ができるため、AddLineメソッドの引数としてそのまま利用することができます。
まとめ
今回は指定の位置から検索文字に線を引くマクロについての解説でした。
サンプルコードでは”ブロックを除いたモデル空間のみ”という限られた空間としていましたが、ブロック内やペーパー空間内のテキストも対応させることは可能です。また、ユーザーがドラッグで選択した要素だけ検索の対象にするというようなこともできるため、いろいろ機能を追加することでより使いやすいマクロにすることができます。
関連書籍
