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

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

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

用途

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

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

使い方

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

作り方

概要

Excelで、ツール／マクロ／Visual Basic Editorを選ぶ
起動したエディタ上で、挿入／標準モジュールを行う
ソースを入力する（コピー／ペーストする）
必要に応じてモジュールの名称を変更する

ソース解説

各種の定義をCadlink.txtから転記します。
（.txt内の定義数が多いので、すべてを含めるとVBAが処理できないため。）
MicroGDSとの通信を開始します。
プリミティブ選択モードかどうかを調べ、違っている場合は通信を止めて終了します。
選択されているプリミティブの数を調べます。選択されているプリミティブがない場合は、通信を止めて終了します。
選択されているプリミティブのリストを取得します。一つ一つのプリミティブは、レイヤ、オブジェクト、プリミティブの3つのリンク番号で特定されます。これは通常CadPriTriple構造体に保存します。ここではCadPriTripleの配列に選択されているプリミティブすべてのリンク番号を取得しています。なお、事前に選択数で配列の大きさを再定義しています。
プリミティブ毎にループします。
リストに記録されているリンク番号で、特定のプリミティブを「カレント」にします。カレントとは、これからプログラムで扱う対象であることを表します。
プリミティブのタイプ（種類）を取得します。タイプが「テキスト」の場合のみ処理を行います。今回はテキストのみを扱いますが、プリミティブには、線やラスター、3Dのデータなど7種類あります。
テキストプリミティブの情報を取得します。
ここでは、表記されている文字列とプリミティブの座標値を読み込み、セルに記入しています。
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
' 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