Option Explicit

Sub テキスト情報をCSVに出力()

   Dim acDoc As AcadDocument
   Dim acEnt As AcadEntity
   Dim lines_count As Integer

    Dim p_xyz() As Double
    Dim str_data As String
    Dim i, num As Integer

    str_data = "空間名称,ﾚｲｱｳﾄ名,,テキストの内容,文字高さ,X座標,Y座標,Z座標" & vbCrLf

   For Each acDoc In Documents
      For Each acEnt In acDoc.ModelSpace
         If (TypeOf acEnt Is AcadText) Or (TypeOf acEnt Is AcadMText) Then
            str_data = str_data & "ModelSpace,,"
            p_xyz = acEnt.InsertionPoint

              str_data = str_data & "モデル空間,""" & acEnt.TextString & """" & "," & acEnt.Height & "," & p_xyz(0) & "," & p_xyz(1) & "," & p_xyz(2) & vbCrLf

         End If
      Next acEnt
   Next acDoc

  num = ThisDrawing.Layouts.Count
'
  For i = 0 To num - 1
  ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item(i)
  Debug.Print ThisDrawing.Layouts.Item(i).Name

    For Each acDoc In Documents
      For Each acEnt In acDoc.PaperSpace
         If (TypeOf acEnt Is AcadText) Or (TypeOf acEnt Is AcadMText) Then
            str_data = str_data & "PaperSpace," & acDoc.PaperSpace.Layout.Name & ","
            p_xyz = acEnt.InsertionPoint

              str_data = str_data & "レイアウト空間,""" & acEnt.TextString & """" & "," & acEnt.Height & "," & p_xyz(0) & "," & p_xyz(1) & "," & p_xyz(2) & vbCrLf

         End If
      Next acEnt
   Next acDoc
  Next i

  MsgBox "テキストのピックアップ終わり"

  Dim file_name_txt, file_name_csv As String

  file_name_csv = Environ("HOMEDRIVE") & Environ("hOMEPATH") & "\Documents\" & ThisDrawing.Name & "のテキスト抽出.csv"

  Open file_name_csv For Output As #1
  Print #1, str_data
  Close #1

  MsgBox "テキスト抽出しました。"

  Shell "C:\Windows\Explorer.exe " & Environ("HOMEDRIVE") & Environ("hOMEPATH") & "\Documents\", vbNormalFocus

End Sub