今更、3DDXFのｲﾝﾎﾟｰﾄに挑む1

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

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

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

うっすらと覚えている範囲で、
・ﾌｧｲﾙの読み込み方が１文字づつ
・点、線、面を全ての面でｲﾝｽﾀﾝｽを作っている
この２点が高速化出来そうだなぁ　と感じたのを覚えています。

そもそも"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"