Excel VBAを使ってAutoCADに文字を挿入する方法

Sub AddTextInAutoCAD()
  Dim acadApp As Object 'AutoCADアプリケーションオブジェクトを宣言
  Dim acadDoc As Object 'AutoCADドキュメントオブジェクトを宣言
  Dim textObj As Object '文字オブジェクトを宣言
  Dim insertPoint(0 To 2) As Double '文字の挿入基点
  Dim text As String '記入する文字列の内容
  Dim textHeight As Double '文字の大きさ
  Dim textRotation As Double '文字の角度
  Dim textAlignment As String '文字基点
  
  'AutoCADを起動または取得
  On Error Resume Next
  Set acadApp = GetObject(,"AutoCAD.Application")
  If acadApp Is Nothing Then
    Set acadApp = CreateObject("AutoCAD.Application")
  End If
  On Error GoTo 0
  
  'AutoCADを表示
  acadApp.Visible = True
  
  'AutoCADドキュメントを新規作成、または取得する。
  On Error Resume Next
  Set acadDoc = acadApp.ActiveDocument
  If acadDoc Is Nothing Then
    Set acadDoc = acadApp.Documents.Add
  End If
  On Error GoTo 0 
  
  '文字の挿入位置、内容、サイズ、角度の設定
  text = Cells(2,1)  '文字内容
  textHeight = Cells(2,2)  '文字の大きさ
  textRotation = Cells(2,3) * (3.14159265358979 / 180) '文字角度。ラジアンに換算。
  textAlignment = Cells(2,4)  '文字基点
  insertPoint(0) = Cells(2,5)  'X座標
  insertPoint(1) = Cells(2,6)  'Y座標
  insertPoint(2) = Cells(2,7)  'Z座標
  
  '文字の生成
  Set textObj = acadDoc.modelSpace.AddText(text, insertPoint, textHeight)
  
  '文字の回転角度を設定
  textObj.Rotation = textRotation
  
  '文字の基点を設定
  Select Case textAlignment
    Case "TL"
      textObj.Alignment = acAlignmentTopLeft   '左上(TL)
    Case "TC"
      textObj.Alignment = acAlignmentTopCenter '上中心(TC)
    Case "TR"
      textObj.Alignment = acAlignmentTopRight  '右上(TR)
    Case "ML"
      textObj.Alignment = acAlignmentMiddleLeft   '中央左(ML)
    Case "MC"
      textObj.Alignment = acAlignmentMiddleCenter '中央中心(MC)
    Case "MR"
      textObj.Alignment = acAlignmentMiddleRight  '右中央(MR)      
    Case "C"
      textObj.Alignment = acAlignmentCenter '基準中心(C)
    Case "R"
      textObj.Alignment = acAlignmentRight  '基準右(R)        
    Case "BL"
      textObj.Alignment = acAlignmentBottomLeft  '左下(BL)
    Case "BC"
      textObj.Alignment = acAlignmentBottomCenter '下中心(BC)
    Case "BR"
      textObj.Alignment = acAlignmentBottomRight  '右下(BR) 
    Case Else
      textObj.Alignment = acAlignmentLeft  '基準左(L)            
    End Select
    
    '位置合わせが基準左の時以外は、TextAlignmentPointを指定する
    If textObj.Alignment <> acAlignmentLeft Then
      textObj.TextAlignmentPoint = insertPoint
    End If
    
    'ハンドル取得
    Cells(2, 8) = textObj.Handle
    
    '再作図
    acadDoc.Regen acActiveViewport
    
    'メッセージを表示
    MsgBox "文字を記入しました！"
  End Sub

Public acadApp As AcadApplication       'AutoCADのアプリケーションドキュメントを保持する変数
Public acadDoc As AutoCAD.AcadDocument  'AutoCADのドキュメントオブジェクトを保持する変数

Function AddTextInAutoCAD(text As String, size As Double, angle As Double, align As String, x1 As Double, y1 As Double, z1 As Double) As String
  'AutoCADに文字を追加する関数
  '引数は最初から順に
  '記入する文字列、文字の大きさ、文字の角度、文字の基点、文字のX座標、Y座標、Z座標
  '戻り値は描画した文字のハンドル
  
  Dim textObj As AcadText 'テキストオブジェクトを保持する変数
  
  Dim insertPoint(2) As Double 'テキストの座標を保持する配列
  
  '文字の座標を設定
  insertPoint(0) = x1
  insertPoint(1) = y1
  insertPoint(2) = z1
  
  Dim textRotation As Double '文字の角度を保持する変数
  textRotation = angle * (3.14159265358979 / 180) '角度をラジアンに換算
  
  '文字の生成
  Set textobj = acadDoc.modelSpace.AddText(text, insertPoint, size)
  
  '文字の回転角度を設定
  textObj.Rotation = textRotation
  
   '文字の基点を設定
  Select Case align
    Case "TL"
      textObj.Alignment = acAlignmentTopLeft   '左上(TL)
    Case "TC"
      textObj.Alignment = acAlignmentTopCenter '上中心(TC)
    Case "TR"
      textObj.Alignment = acAlignmentTopRight  '右上(TR)
    Case "ML"
      textObj.Alignment = acAlignmentMiddleLeft   '中央左(ML)
    Case "MC"
      textObj.Alignment = acAlignmentMiddleCenter '中央中心(MC)
    Case "MR"
      textObj.Alignment = acAlignmentMiddleRight  '右中央(MR)      
    Case "C"
      textObj.Alignment = acAlignmentCenter '基準中心(C)
    Case "R"
      textObj.Alignment = acAlignmentRight  '基準右(R)        
    Case "BL"
      textObj.Alignment = acAlignmentBottomLeft  '左下(BL)
    Case "BC"
      textObj.Alignment = acAlignmentBottomCenter '下中心(BC)
    Case "BR"
      textObj.Alignment = acAlignmentBottomRight  '右下(BR) 
    Case Else
      textObj.Alignment = acAlignmentLeft  '基準左(L)            
    End Select
    
    '位置合わせが基準左の時以外は、TextAlignmentPointを指定する
    If textObj.Alignment <> acAlignmentLeft Then
      textObj.TextAlignmentPoint = insertPoint
    End If 

  
  '追加した線分のハンドルを返す
  AddTextInAutoCAD = textObj.Handle
  
End Function

public Sub main()
  On Error GoTo OUT1 'エラーハンドリング：AutoCADが起動していないとき
  Set acadApp =GetObject（,"AutoCAD.Application") '既存のAutoCADアプリケーションの取得
  
  On Error GoTo OUT2 'エラーハンドリング：AutoCADのファイルが開かれてない場合
  Set acadDoc = acadApp.ActiveDocument 'アクティブなAutoCADドキュメントを取得
  
  On Error GoTo 0 'エラーハンドリングをリセット
  
  'AutoCADに文字を描画し、そのハンドルをExcelに書き込む
  Cells(2,8) = AddTextInAutoCAD(Cells(2,1), Cells(2,2), Cells(2,3), Cells(2,4), Cells(2,5), Cells(2,6), Cells(2,7))

  
  Exit Sub
OUT1:
  MsgBox "AutoCADを起動してください"
  Exit Sub
OUT2:
　MsgBox "AutoCADのファイルを開いてください"
End Sub

Cells(2,8) = AddTextInAutoCAD("てすと", 100, 0, "L", 100, 200, 0)

dummy = AddTextInAutoCAD("てすと", 100, 0, "L", 100, 200, 0)