C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

今更、3DDXFのインポートに挑む1

DXFは、2Dだけだと思っていたのですが、V5BBSさんの
この記載を見て、3Dも存在することを7・8年前ぐらい
知りました。

dxf-3Dを読む


面白そうなので、試しにやってみようと思ったのですが
何故かマクロが動きませんでした。

当時、"動くように直そう" と思ってコードを見たところ
もっと高速化できる余地が有ったので、自作してみたの
ですが、管理が悪くコードがどこかに行ってしまいました・・。

うっすらと覚えている範囲で、
・ファイルの読み込み方が1文字づつ
・点、線、面を全ての面でインスタンスを作っている
この2点が高速化出来そうだなぁ と感じたのを覚えています。

そもそも"3DDXFをCADにインポートする価値があるのか?" と
言われるとほぼ無いと思われますが、せっかくなので
作っています。


まず、3DDXFフォーマットですが、こちらに少し記載されています。
DXFファイルフォーマット
3DDXFは四角ポリゴンを採用しているようです。
ポリゴンは全て三角形だと思っていたのですが、四角のものが
存在している事自体、当時軽くショックを受けたのを覚えています。
(三角は1つの平面が決まるが、四角の頂点が同一平面上にある
とは限らない)
emilyさんのコードを見てみると、3点目と4点目の座標値が同一
の場合は三角ポリゴンとして扱っているようです。


改善の余地があるのですが、とりあえずコードです。
まず、座標値XYZを保持するクラスです。

'VBA Pnt3DDXF.cls
Option Explicit

'メンバ
Private mX As Double, mY As Double, mZ As Double

'数値設定用定数(3DDXF用)
Private Const TypeX = 10, TypeY = 20, TypeZ = 30

'数値設定用フラグ
Private mValueSet As Byte
Private Const xFg = 1, yFg = 2, zFg = 4, CanExecuteFg = xFg + yFg + zFg

Private Sub Class_Initialize()
    mValueSet = 0
End Sub

Public Sub SetPosition(ByVal XYZ As Long, ByVal v As Double)
    Select Case XYZ
        Case TypeX
            mX = v: mValueSet = mValueSet Or xFg
        Case TypeY
            mY = v: mValueSet = mValueSet Or yFg
        Case TypeZ
            mZ = v: mValueSet = mValueSet Or zFg
    End Select
End Sub

Property Get x() As Double
    x = mX
End Property

Property Get Y() As Double
    Y = mY
End Property

Property Get Z() As Double
    Z = mZ
End Property

Public Function ToArray(Optional ByVal Scl As Double) As Variant
    If Scl = 0 Then Scl = 1
    ToArray = Array(mX * Scl, mY * Scl, mZ * Scl)
End Function

Public Function CanExecute() As Boolean
    CanExecute = IIf((mValueSet And CanExecuteFg) = CanExecuteFg, True, False)
End Function

昔だったら

Public x As Double
Public y As Double
Public z As Double

この程度のクラス作っておしまいだったのですが、成長しました。

ネーミングがおかしい気がするのですが、CanExecute関数は
XYZ全てに値が設定されたか?を確認する為のものです。
又、ToArray関数は、CATIAで点を作る際にVariant型の配列
が必要になる為、用意しました。



続いて、1枚面分の座標値を保持するクラスです。

'VBA Face3DDXF.cls
Option Explicit
'メンバ
Private mPnts As Collection
Private Const EqualTolerance = 0.00001 '同一点トレランス
Private Const SquareEqualTolerance = EqualTolerance * EqualTolerance

Private Sub Class_Initialize()
    Set mPnts = New Collection
End Sub

Private Sub Class_Terminate()
    Set mPnts = Nothing
End Sub

Property Get Count() As Long
    Count = mPnts.Count
End Property

Property Get Item(ByVal i As Long) As Double
    If i < mPnts.Count Or i > mPnts.Count Then
        Item = Empty
    End If
    Item = mPnts(i)
End Property

Public Sub Push(ByVal Pnt As Pnt3DDXF)
    Dim P As Pnt3DDXF
    For Each P In mPnts
        If Equals(P, Pnt) Then Exit Sub
    Next
    mPnts.Add Pnt
End Sub

Public Function GetPointAry(ByVal Scl As Double) As Collection
    Dim Ary As Collection: Set Ary = New Collection
    Dim P As Pnt3DDXF
    For Each P In mPnts
        Call Ary.Add(P.ToArray(Scl))
    Next
    Set GetPointAry = Ary
End Function

Private Function Equals(P1 As Pnt3DDXF, P2 As Pnt3DDXF) As Boolean
     Equals = IIf((P2.x - P1.x) * (P2.x - P1.x) + _
                  (P2.Y - P1.Y) * (P2.Y - P1.Y) + _
                  (P2.Z - P1.Z) * (P2.Z - P1.Z) < SquareEqualTolerance, _
                  True, False)
End Function

3点目と4点目の座標値が同一?を判断する為にEquals関数を
用意しました。 PCの場合、どうしても丸め誤差が発生してしまう為
数値の比較を " = " で行わない方が良い と何処かで読んだ事が
有ります。 その為2点間距離がトレランス(結構適当です)以下の場合を
"同一座標" と判断しています。
(2点間距離計算も平方根計算を避け、平方数で行っています)


残りのコードは次回以降で。

こちらのデータをお借りし試しています。
ウェブプラモ|パーツをダウンロードして作るプラモデル

取り込み後の画像はこちら
f:id:kandennti:20160217150846p:plain
S800の "bumper_r"

f:id:kandennti:20160217151052p:plain
NRの "head_cowl"
四角ポリゴンの一部、形状が崩壊・・・