DxfExtractGroup

説明

DXFファイル内の指定した単一オブジェクトから、反復して現れるグループ(例えばポリラインの頂点データ)の値を抽出します。

　

書式

Object.DxfExtractGroup(retCount,ExtractArray,StartLineNo,GroupList,[DxfFullPath]) As Boolean

引数 説明
retCount 抽出されたオブジェクトの数を返す変数を指定します。
ExtractArray 抽出結果が2次元の配列で返されます。
StartLineNo 抽出したいオブジェクトのDXFファイル内での行番号を指定します。
※使用例の補足説明をお読み下さい。
GroupList 抽出したい複数のグループコードをパイプ文字で区切って指定します。
DxfFullPath 省略可能です。省略するとWindowsテンポラリフォルダ内のAcadRemocon.dxfになります。

　

戻り値

戻り値 説明
True 正常終了しました。
False 異常終了しました。エラーの詳しい内容はShowErrorメソッドで確認出来ます。

　

使用例(VBScript)

補足説明：
13行目のDxfExtractメソッドでポリラインを変数Objに取得しています。
配列変数Obj(1,1)には1個目のポリラインのグループコード8の内容が格納されています。
更にObj(グループコードの数+1,1)には1個目のポリラインのDXFファイル内での開始行番号が格納されています。
この例ではグループコードの数+1=2になりますが、グループコードの数を変更しても影響を受けないように、19行目ではUBound(Obj, 1)と記述しています。
これはDxfExtractGroupおよびDxfExtractBlockメソッドを使う場合の定石として覚えておいて下さい。

Dim Acad 'Acad変数はErサブルーチンでも使うのでここで宣言
Call Main

Sub Main()
  'AcadRemoconオブジェクト作成
  Set Acad = CreateObject("AcadRemocon.Body")

  'バージョンチェック
  If Not Acad.CheckVersion("220") Then Exit Sub

  'ポリライン抽出
  If Not Acad.acDxfOut("ポリラインを選択", "", False) Then Er: Exit Sub
  If Not Acad.DxfExtract(ObjCnt, Obj, "ENTITIES", "", "LWPOLYLINE", "8") Then Er: Exit Sub
  If ObjCnt = 0 Then Exit Sub

  'ポリラインを後方からループ(ファイルの行数が変わるので後方から処理)
  For i = ObjCnt To 1 Step -1
    '頂点データを取得
    If Not Acad.DxfExtractGroup(GrpCnt, Grp, Obj(UBound(Obj, 1), i), "10|20") Then Er: Exit Sub

    '頂点数が2個以上で始点と終点が異なる場合は始点と同じ座標の頂点データを追加
    If GrpCnt > 2 And Abs(Grp(1, GrpCnt) - Grp(1, 1)) > 1 And Abs(Grp(2, GrpCnt) - Grp(2, 1)) > 1 Then
      Grp(2, GrpCnt) = Grp(2, GrpCnt) & vbCrLf & "10" & vbCrLf & Grp(1, 1) & vbCrLf & "20" & vbCrLf & Grp(2, 1)
      If Not Acad.DxfUpdate(Grp) Then Er: Exit Sub
    End If
  Next

  '直前の選択セットを削除
  If Not Acad.acPostCommand("UNDO BE ") Then Er: Exit Sub 'UNDO記録開始
  If Not Acad.acDxfIn() Then Er: Exit Sub 'DXF読み込み
  If Not Acad.acPostCommand("ERASE P ") Then Er: Exit Sub '直前の選択セットを削除
  If Not Acad.acPostCommand("UNDO E ") Then Er: Exit Sub 'UNDO記録終了
End Sub

'エラー処理
Sub ER()
  'ユーザーによるキャンセル
  If Acad.ErrNumber = vbObjectError + 1000 Then
    'ここにキャンセル時の処理を追加
  Else
    'エラー内容表示
    Acad.ShowError
  End If
End Sub