Excelファイルからテキストを配置するマクロ｜AutoCAD VBAマクロの作成方法

AutoCAD VBAはExcelと連携させることでより効果的な自動化ツールを作成することができるようになります。本ページではExcelファイルに記載されている情報からAutoCAD上にテキストを一括作成する方法について解説していきます。サンプルコードはかなり単純なコードとなっていますが骨組み部分はできているので、処理を多少追加するだけでより汎用的なマクロとすることが可能です。

Excelとの連携方法は下記ページで解説しているので先に一読しておくことをオススメします。

AutoCAD VBAでExcelを操作する方法｜AutoCAD VBAマクロの作成方法

本ページではAutoCAD VBAでExcelを操作する方法を解説していきます。 AutoCADとExcelと連携することで ...

https://liclog.net/export-excel-macro-vba-autocad/

1. マクロ機能
2. サンプルコード
3. コード解説　
4. まとめ

マクロ機能

マクロの機能まとめ・Excelファイル記載の情報から指定の位置にテキストを一括作成する
・テキストの作成先はアクティブドキュメントのモデル空間
・読み込むExcelファイルはA列がX座標、B列がY座標、C列がテキストの文字列であること
1行目はヘッダーとして2行目以降にテキスト作成用データを記載のこと
・Excelファイルに記載可能なテキスト情報の上限はExcelの最大行数

サンプルマクロでは作成するテキストの情報として設定可能な項目は「配置する座標」と「テキストの文字列」のみとなっています。コードと入力するExcelのフォーマットを少し追加することで、テキスト高さや角度、色や画層なども設定したテキストを作成することが可能になります。
　

サンプルコード

下記は指定したExcelファイルに記載されているテキスト情報のデータを取得して、その情報をもとにAutoCADでダイナミックテキストを一括作成するためのサンプルコードです。

Option Explicit
'*****************************************************************************
'*  ﾒｲﾝ関数
'*****************************************************************************
Sub main()

    Dim oTable As AcadTable
    Dim sPathExcel As String
    
    'Excelﾌｧｲﾙﾊﾟｽ指定
    sPathExcel = "C:\...\TextInfo.xlsx"

    'Excelから表作成
    Call ImportTextData(sPathExcel)

End Sub
'-----------------------------------------------------------------------------
'-  Excel記載の座標と文字列情報から指定の位置にﾃｷｽﾄを一括作成する
'-      sPathExcel  ：Excelﾌｧｲﾙﾊﾟｽ (1つ目のｼｰﾄが対象)
'-----------------------------------------------------------------------------
Private Sub ImportTextData(ByVal sPathExcel As String)

    Dim oExcel As Object
    Dim wbImport As Object 'Workbook
    Dim wsImport As Object 'Worksheet
    Dim vDatas As Variant
    Dim oText As AcadText
    Dim sText As String
    Dim arr_dPos(0 To 2) As Double
    Dim r As Long
    
    '入力ﾊﾟｽからExcelﾌｧｲﾙを裏側で開く
    Set oExcel = CreateObject("Excel.Application")
    Set wbImport = oExcel.Workbooks.Open(sPathExcel)
    Set wsImport = wbImport.Worksheets.Item(1)
    
    'ﾃﾞｰﾀ取得 (※表はA1ｾﾙから始まっている必要あり)
    vDatas = wsImport.Cells(1, 1).CurrentRegion
    
    'Excel終了
    Call oExcel.Quit

    'ﾃｷｽﾄ一括作成
    For r = 2 To UBound(vDatas, 1)
    
        'Excelから情報取得
        arr_dPos(0) = vDatas(r, 1)  'X座標取得
        arr_dPos(1) = vDatas(r, 2)  'Y座標取得
        sText = vDatas(r, 3)        'ﾃｷｽﾄ取得
        
        'ﾀﾞｲﾅﾐｯｸﾃｷｽﾄ作成
        Set oText = ThisDrawing.ModelSpace.AddText(sText, arr_dPos, 5)
    Next
    
    '画面再描画
    Call ThisDrawing.Regen(acAllViewports)

End Sub

Option Explicit

'*****************************************************************************

'* ﾒｲﾝ関数

'*****************************************************************************

Sub main()

Dim oTable As AcadTable

Dim sPathExcel As String

'Excelﾌｧｲﾙﾊﾟｽ指定

sPathExcel = "C:\...\TextInfo.xlsx"

'Excelから表作成

Call ImportTextData(sPathExcel)

End Sub

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

'- Excel記載の座標と文字列情報から指定の位置にﾃｷｽﾄを一括作成する

'- sPathExcel ：Excelﾌｧｲﾙﾊﾟｽ (1つ目のｼｰﾄが対象)

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

Private Sub ImportTextData(ByVal sPathExcel As String)

Dim oExcel As Object

Dim wbImport As Object 'Workbook

Dim wsImport As Object 'Worksheet

Dim vDatas As Variant

Dim oText As AcadText

Dim sText As String

Dim arr_dPos(0 To 2) As Double

Dim r As Long

'入力ﾊﾟｽからExcelﾌｧｲﾙを裏側で開く

Set oExcel = CreateObject("Excel.Application")

Set wbImport = oExcel.Workbooks.Open(sPathExcel)

Set wsImport = wbImport.Worksheets.Item(1)

'ﾃﾞｰﾀ取得 (※表はA1ｾﾙから始まっている必要あり)

vDatas = wsImport.Cells(1, 1).CurrentRegion

'Excel終了

Call oExcel.Quit

'ﾃｷｽﾄ一括作成

For r = 2 To UBound(vDatas, 1)

'Excelから情報取得

arr_dPos(0) = vDatas(r, 1) 'X座標取得

arr_dPos(1) = vDatas(r, 2) 'Y座標取得

sText = vDatas(r, 3) 'ﾃｷｽﾄ取得

'ﾀﾞｲﾅﾐｯｸﾃｷｽﾄ作成

Set oText = ThisDrawing.ModelSpace.AddText(sText, arr_dPos, 5)

'画面再描画

Call ThisDrawing.Regen(acAllViewports)

End Sub

コード解説　

Excel情報取得

AutoCAD VBAでExcel VBAを利用できるようにするためには、ExcelオブジェクトをCreateObjectで作成する必要があります。(※詳しくはAutoCAD VBAでExcelを操作する方法を参照ください)

出力するデータの対象のシートは「Item(1)」、表も「Cells(1, 1).CurrentRegion」というように決め打ちのコードとなっています。この取得方法は適宜入力データに合わせて変更する必要があります。

データ取得後は2次元配列にデータが格納され、Excel自体は不要になるのでデータ取得直後に終了させています。この終了処理が行われないとバックグラウンドでExcelが開き続けてしまうので注意が必要です。デバッグエラーで途中で止まってしまい終了処理が行われなかった場合も裏に残ってしまうため、基本的には不要になったタイミングで即時終わらせるほうが安心です。

バックグラウンドに残ってしまったExcelはタスクマネージャから手動で終了させることができます。
　　

ダイナミックテキスト作成

ダイナミックテキストはModelSpaceオブジェクトのAddTextメソッドを使い作成することができます。引数としては「値, 作成位置(配列), テキスト高さ」の3つの情報が必要になります。サンプルコードではこれら情報をExcel記載のデータから取得してそのまま引数として入力しています。このときテキストの高さを設定するための第3引数には適当な定数値として”5″を入力しています。

        'Excelから情報取得
        arr_dPos(0) = vDatas(r, 1)  'X座標取得
        arr_dPos(1) = vDatas(r, 2)  'Y座標取得
        sText = vDatas(r, 3)        'ﾃｷｽﾄ取得
        
        'ﾀﾞｲﾅﾐｯｸﾃｷｽﾄ作成
        Set oText = ThisDrawing.ModelSpace.AddText(sText, arr_dPos, 5)

'Excelから情報取得

arr_dPos(0) = vDatas(r, 1) 'X座標取得

arr_dPos(1) = vDatas(r, 2) 'Y座標取得

sText = vDatas(r, 3) 'ﾃｷｽﾄ取得

'ﾀﾞｲﾅﾐｯｸﾃｷｽﾄ作成

Set oText = ThisDrawing.ModelSpace.AddText(sText, arr_dPos, 5)

作成したダイナミックテキストはTextオブジェクトとして取得できますが、このTextオブジェクトのプロパティ/メソッドを使うことで作成したテキストに対して色の変更や角度変更、文字スタイルの変更などの様々な設定を行うことができます。
　

まとめ

今回はExcelで作成した表の情報をもとにテキストを一括で作成する方法についての内容でした。

サンプルコードでは作成する座標とテキストの文字列のみしか設定できませんでしたが、コードに少し処理を書き加えるだけで色の設定や文字スタイルの設定、テキスト高さの設定など様々な条件を追加することができます。コードとしてはかなり単純な内容ですが、指定の位置にテキストを作成する作業を一瞬で終わらすことができるため、自動化によるコスト削減の効果はかなり大きいです。
　

メインページへ戻る