MicroGDS 機能と特長

VBAによる「文字列取得」サンプル　

ExcelのVBAを使って、MicroGDSの図面からテキストを読み取るカスタマイズサンプルをご紹介します。
※本ページは、MicroGDS V10までの内容で記載されております。

MicroGDS V11より、.NET APIインターフェースのみのサポートとなります。

用途

表や仕様の文字など、図面に並べて描かれているテキストを取り込んでExcelシートに転記します。 図面上の位置を読み取って、上にあるものから順にシートの行に並べます。

VBAによる「文字列取得」サンプルツール

使い方

  1. MicroGDSでテキストを読み取りたい図面を表示し、プリミティブ選択モード(F9)で、 テキストを選択します。
  2. Excelでマクロを起動します。選択したテキストが新たなシートに転記されます。
    ※テキストが左右に並んでいる場合、シートの行の上下は不定です。 　
    （このサンプルプログラムでは、横方向の位置の処理は行っていません。）

作り方

概要
  1. Excelで、ツール／マクロ／Visual Basic Editorを選ぶ
  2. 起動したエディタ上で、挿入／標準モジュールを行う
  3. ソースを入力する（コピー／ペーストする）
  4. 必要に応じてモジュールの名称を変更する
ソース解説
  1. 各種の定義をCadlink.txtから転記します。
    （.txt内の定義数が多いので、すべてを含めるとVBAが処理できないため。）
  2. MicroGDSとの通信を開始します。
  3. プリミティブ選択モードかどうかを調べ、違っている場合は通信を止めて終了します。
  4. 選択されているプリミティブの数を調べます。選択されているプリミティブがない場合は、通信を止めて終了します。
  5. 選択されているプリミティブのリストを取得します。一つ一つのプリミティブは、レイヤ、 オブジェクト、プリミティブの3つのリンク番号で特定されます。これは通常CadPriTriple構造体に保存します。ここではCadPriTripleの配列に選択されているプリミティブすべてのリンク番号を取得しています。なお、事前に選択数で配列の大きさを再定義しています。
  6. プリミティブ毎にループします。
  7. リストに記録されているリンク番号で、特定のプリミティブを「カレント」にします。 カレントとは、これからプログラムで扱う対象であることを表します。
  8. プリミティブのタイプ（種類）を取得します。 タイプが「テキスト」の場合のみ処理を行います。 今回はテキストのみを扱いますが、プリミティブには、線やラスター、3Dのデータなど7種類あります。
  9. テキストプリミティブの情報を取得します。
    ここでは、表記されている文字列とプリミティブの座標値を読み込み、セルに記入しています。
  10. Excelの関数を用いて、プリミティブのY座標値の大小（図面上の上下）でソートを行います。
    ※プログラムから選択リストを用いたり、ループしてプリミティブの情報を取得する場合、 結果の値は図面内の見た目の位置とは異なる順序で返ってきます。 このため、位置による結果を必要とする場合は、プログラムで判断して処理を行う必要があります。今回は、Excelのソート関数を利用して記載位置を再現する並べ替えを行っています。

サンプルソース

Option Explicit

' * Module:      Cadlink/Cadlnk60
' * Version:     10.0

' conversation constants
Global Const MGDS_CCS_REFCOUNT = 1
Global Const MGDS_CCS_ANY = 0   ' cad conversation - which session (number or "any")

' Constants used for identifying the current selection mode
Global Const SELMODE_PRIM = 2   ' primitive select mode

' ****************************************
' Cadlink CadVector Data Type Definition
' ****************************************

Type CadVector
    x As Double              ' x component
    y As Double              ' y component
    z As Double              ' z component
End Type

' ******************************************
' Cadlink CadPriTriple Data Type Definition
' ******************************************

Type CadPriTriple
    llink As Long            ' layer link number
    vlink As Long            ' version link number
    plink As Long            ' primitive link number
End Type

' ************************************
' Cadlink CadAxes data type definition - used to transform between axis frames.
' ************************************

Type CadAxes
    origin As CadVector      ' axes hook position
    xAxis As CadVector       ' axes x direction
    yAxis As CadVector       ' axes y direction
    zAxis As CadVector       ' axes z direction
    axesScale As Double      ' axes scale
    handedness As Long       ' handedness
End Type

' ****************************************
' Cadlink Function declarations
' ****************************************
Declare Function CadConvStartEx Lib "cadlnk60.dll" (ByVal sessionId As Long, _
    ByVal refCount As Long, ByVal timeout As Long) As Long
Declare Function CadConvStop Lib "cadlnk60.dll" () As Long
Declare Function CadGetSelectMode Lib "cadlnk60.dll" () As Long
Declare Function CadGetNumSelPrim Lib "cadlnk60.dll" () As Long
Declare Function CadCurPrimitive Lib "cadlnk60.dll" (ByVal llink As Long, _
    ByVal olink As Long, ByVal plink As Long) As Long
Declare Function CadGetCurPriFormattedText Lib "cadlnk60.dll" (priText As String, _
    ByVal options As String) As Long
Declare Function CadGetCurPriTextAxes Lib "cadlnk60.dll" (axes As CadAxes, _
    yfactor As Double) As Long
Declare Function CadGetCurPriType Lib "cadlnk60.dll" (priType As String) As Long
Declare Function CadGetPriSelections Lib "cadlnk60.dll" (ByVal nPrims As Long, _
    primArray As CadPriTriple) As Long

Public Sub gettext()
    Dim rv As Long
    Dim numsel As Long
    Dim n As Long
    Dim prilist() As CadPriTriple
    Dim ptype As String
    Dim selmode As Long
    Dim ptext As String
    Dim paxes As CadAxes
    Dim yfactor As Double
    Dim newsheet As Worksheet
    Dim isnewsheet As Long  ' シートを作ったかのフラグ、初期値0
    Dim linecount As Long   ' 行カウントの変数、初期値0

    isnewsheet = 0
    linecount = 0

    ' MicroGDSとの通信を開始
    rv = CadConvStartEx(MGDS_CCS_ANY, MGDS_CCS_REFCOUNT, 2000)
    
    ' プリミティブ選択モードのチェック
    selmode = CadGetSelectMode()
    If selmode <> SELMODE_PRIM Then
        ' MicroGDSとの通信を終了
        rv = CadConvStop()
        Exit Sub
    End If

    ' 選択数のチェック
    numsel = CadGetNumSelPrim()
    If numsel <= 0 Then
        ' MicroGDSとの通信を終了
        rv = CadConvStop()
        Exit Sub
    End If
    
    ' 選択中のプリミティブのリンク番号を取得
    ReDim prilist(numsel)
    rv = CadGetPriSelections(numsel, prilist(0))

    ' プリミティブ毎にループ
    For n = 0 To numsel - 1
        ' プリミティブをカレントにする
        With prilist(n)
            rv = CadCurPrimitive(.llink, .vlink, .plink)
        End With
        
        ' テキストプリミティブの場合
        rv = CadGetCurPriType(ptype)
        If ptype = "TEXT" Then
            ' データと位置を取得
            rv = CadGetCurPriFormattedText(ptext, "EXPANDED=YES, MARKUP=NO")
            rv = CadGetCurPriTextAxes(paxes, yfactor)
            
            If isnewsheet = 0 Then
                ' シートを作っていなければ作成
                Set newsheet = Worksheets.Add()
                isnewsheet = 1
            End If
            
            ' 行カウントの行に、テキスト原点のｙ座標値とテキスト内容とを記載
            newsheet.Cells(linecount + 1, 1) = paxes.origin.y
            newsheet.Cells(linecount + 1, 2) = ptext
            linecount = linecount + 1
        End If
    Next n
    
    ' 行カウントが0でない場合
    If linecount > 0 Then
        ' Yの値でソートを行なう。
        newsheet.Range("A1:B" & linecount).Sort key1:=Range("A1"), order1:=xlDescending
        
        ' Yのカラムを消す
        newsheet.Range("A:A").Delete
    End If
    
    ' MicroGDSとの通信を終了
    rv = CadConvStop()

End Sub