ﾗｲｾﾝｽ無しでSTLをCATIAに取り込む3(STLだけじゃない)

こちらの続きですが
ﾗｲｾﾝｽ無しでSTLをCATIAに取り込む2 - C#ATIA
どちらかと言うと、こっちかな？
ﾗｲｾﾝｽ無しでSTLをCATIAに取り込む - C#ATIA
続mayo - C#ATIA

作ろうと思ってすっかり忘れていたのですが、先日見つけたmayo経由で
メッシュファイルを開くマクロを作りました。

'vba open_mesh_via_mayo ver0.0.1 by kantoku
'stl,gltf,obj,vrml,off,plyファイルをmayo経由で開きます

Option Explicit

'** ここを設定してください **
'mayoの実行ファイルパス
Private Const MAYO_PATH = "C:\Program Files\Fougue\Mayo\mayo.exe"
'** ここまで **


'クリアするレジストリ-2バイト文字対策
'https://github.com/fougue/mayo/issues/177
Private Const REGISTRY_KEY = "HKEY_CURRENT_USER\SOFTWARE\Fougue Ltd\Mayo\application\lastOpenFolder"
'***

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Const DEBUG_ = False

Sub CATMain()
    'チェック
    If Not can_execute() Then Exit Sub

    'ファイル選択
    Dim meshPath
    meshPath = select_mesh_file()
    If Len(meshPath) < 1 Then Exit Sub

    '一時的にvrmlファイル変換
    Dim wrlPath As String
    wrlPath = create_vrml(meshPath)

    '新規プロダクトドキュメント
    Dim prodDoc As ProductDocument
    Set prodDoc = CATIA.Documents.Add("Product")
    
    'vrmlのインポート
    Call import_wrl(prodDoc, wrlPath)

    'リフレーム-リフレッシュ
    CATIA.ActiveWindow.ActiveViewer.Reframe
    CATIA.RefreshDisplay = True

    '掃除
    If is_exists(wrlPath) Then
        remove_file wrlPath
    End If

    MsgBox "Done"
End Sub


'メッシュファイルの選択
Private Function select_mesh_file() _
    As String
    
    Dim filter As Variant
    filter = Array( _
        "*.stl", _
        "*.obj", _
        "*.gltf", _
        "*.glb", _
        "*.off", _
        "*.ply", _
        "*.wrl", _
        "*.wrz", _
        "*.vrml" _
    )
    
    select_mesh_file = CATIA.FileSelectionBox( _
        "メッシュファイルの選択", _
        Join(filter, ";"), _
        CatFileSelectionModeOpen _
    )
    
End Function


'vrmlのインポート
Private Sub import_wrl( _
    ByVal doc As ProductDocument, _
    ByVal path As String) _

    Dim aryPath As Variant
    aryPath = Array(path)

    Dim variProds As Variant
    Set variProds = doc.product.Products

    On Error Resume Next
        variProds.AddComponentsFromFiles aryPath, "All"
    On Error GoTo 0
End Sub


'作業用フォルダパス取得
Private Function get_temp_dir_path() _
    As String
    
    Dim dirPath As String
    dirPath = CATIA.SystemService.Environ("CATTemp")
    
    If Len(dirPath) > 0 Then
        get_temp_dir_path = dirPath
        Exit Function
    End If

    dirPath = "C:\temp"
    If is_exists(dirPath) Then
        get_temp_dir_path = dirPath
        Exit Function
    End If

    '見つからん
    get_temp_dir_path = ""

End Function


' *** mayo ***
'実行前チェック
Private Function can_execute() _
    As Boolean

    can_execute = True
    Dim res
    res = is_exists(MAYO_PATH)
    If Not res Then
        MsgBox "mayoの実行ファイルパスが正しくありません。修正してください。"
        can_execute = False
    End If
End Function


'拡張子毎にvrmlファイルを作製
Private Function create_vrml( _
    ByVal importPath As String) _
    As String
    
    Dim tmpPath As Variant
    tmpPath = split_path_name(importPath)

    Dim meshPath As String
    Select Case LCase(tmpPath(2))
        Case "wrl"
            meshPath = importPath
        Case "stl"
            meshPath = mesh_to_mesh( _
                importPath, _
                "wrl" _
            )
        Case Else
            meshPath = mesh_to_mesh( _
                importPath, _
                "stl" _
            )
            meshPath = mesh_to_mesh( _
                meshPath, _
                "wrl", _
                True _
            )
    End Select
    
    create_vrml = meshPath
    
End Function


'メッシュを指定拡張子で変換
'extension-変換後拡張子
'removeFile-変換後元ファイルの削除
Private Function mesh_to_mesh( _
    ByVal importPath As String, _
    ByVal extension As String, _
    Optional ByVal removeFile = False) _
    As String

    Dim tempPath As Variant
    tempPath = split_path_name(importPath)

    Dim exportPath As String
    exportPath = get_temp_dir_path() & "\" & tempPath(1) & "." & extension
    Call dump("exportPath:" & exportPath)

    If is_exists(exportPath) Then
        remove_file exportPath
    End If

    Dim cmd As String
    cmd = _
        Chr(34) & MAYO_PATH & Chr(34) & " " & _
        Chr(34) & importPath & Chr(34) & " " & _
        " --export " & Chr(34) & exportPath & Chr(34)

    If exist_key(REGISTRY_KEY) Then
        clearing_registry REGISTRY_KEY
    End If

    Dim objShell
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run cmd, vbNormalFocus, True
    
    If is_exists(exportPath) Then
        mesh_to_mesh = exportPath
    Else
        mesh_to_mesh = ""
    End If

    If removeFile And is_exists(importPath) Then
        remove_file importPath
    End If
End Function


' *** registry ***
' レジストリの値をクリア
Private Sub clearing_registry( _
    key)

    Dim objWsh
    Set objWsh = CreateObject("Wscript.Shell")

    Call objWsh.RegWrite(key, "")
End Sub


' レジストリキーの有無
Private Function exist_key( _
    key) As Boolean

    Dim objRegistry, arrSubKeys
    Set objRegistry = GetObject("winmgmts:root\default:StdRegProv")
    If objRegistry.EnumKey(HKEY_LOCAL_MACHINE, key, arrSubKeys) = 2 Then
        exist_key = True
    Else
        exist_key = False
    End If
End Function


' *** IO ***
'FileSystemObject
Private Function get_fso() _
    As Object

    Set get_fso = CreateObject("Scripting.FileSystemObject")
End Function


'ﾊﾟｽ/ﾌｧｲﾙ名/拡張子 分割
'Return: 0-path 1-BaseName 2-Extension
Private Function split_path_name( _
    ByVal fullpath) _
    As Variant

    Dim path(2) As String
    With get_fso
        path(0) = .GetParentFolderName(fullpath)
        path(1) = .GetBaseName(fullpath)
        path(2) = .GetExtensionName(fullpath)
    End With

    split_path_name = path
End Function


'ﾊﾟｽ/ﾌｧｲﾙ名/拡張子 連結
Private Function join_path_name( _
    ByVal path) _
    As String

    If Not IsArray(path) Then Stop '未対応
    If Not UBound(path) = 2 Then Stop '未対応

    join_path_name = path(0) + "\" + path(1) + "." + path(2)
End Function


'ﾌｧｲﾙの有無
Private Function is_exists( _
    ByVal path) _
    As Boolean

    is_exists = get_fso.FileExists(path)
End Function


'ﾌｧｲﾙの削除
Private Sub remove_file( _
    ByVal path)

    get_fso.DeleteFile path
End Sub


' *** debug ***
Private Sub dump(msg As String)
    If Not DEBUG_ Then Exit Sub
    
    Debug.Print msg
End Sub

こんな動作です。

サンプルデータはスミソニアン博物館からお借りしました。
3D Digitization |

以下、注意点です。
〇本マクロは単体では機能しません。OSS”mayo"がインストールされている
　必要があります。
　又、マクロの先頭付近の

Private Const MAYO_PATH = "C:\Program Files\Fougue\Mayo\mayo.exe"

　部分をmayoのインストールされたパスに設定してください。
　（現在はデフォルトインストールパスになっています）
〇開いたファイルは未保存です。".cgr"等で保存する事をお勧めします。
〇対象フォーマットは以下のものです。

　但し、stl,obj,wrlファイルしかテストしておりません。
　（不具合有ったら教えて欲しい・・・）
〇基本的に形状のみで色は反映されません。
〇サイズについては、オプションのこちらの設定に依存しています。
　元ファイルの単位が事前にわかっているのであれば、予め設定して
　おいてください。

　ひょっとしたら、mayoの設定の影響もあるかも知れません。
Export parameters by CAD format · fougue/mayo Wiki · GitHub
〇諸事情によりエラー無く開かれたものの、空っぽのファイルの可能性もあります。

以下、試してわかった事と裏事情。
〇ファイルの拡張子によって処理を分けています。
　・"wrl":　そのままcatiaでオープン（catiaでエクスポートしたwrl以外はダメっぽい）
　・"stl":　stl -> wrl -> オープン
　・その他:　obj等 -> stl -> wrl -> オープン
　試したところ、stl以外のフォーマットからwrlにエクスポートしたファイルは
　catiaでNGでした。mayoの問題と言うよりOpen CASCADEの問題の気がします。
　mayoでエクスポートしたwrlをmayoで開けない状態です。
　wrlは方言が強いのかな・・・。
〇2バイト文字を含むパスを処理した際の問題がありますが、
　こちらのレジストリ削除の処理は組み込んでいます。
mayoクラッシュ原因となるレジストリのクリア - C#ATIA
　但し、2バイト文字を含むパスのファイルはファイル名変更等を
　行ってから開くことをお勧めします。
〇一時的なファイルを作って処理していますが、ファイルの作成場所は
　環境変数の"CATTemp"フォルダを使用しています。
　環境変数が見つからない場合は、"C:\temp"フォルダです。
　又、一時的なファイルはエラー等を起こさない限り、削除して
　終了させています。
〇ファイルを選択するダイアログのFileSelectionBoxメソッドは
　複数フィルタの設定は ";" 区切り（忘れそう）
〇FileSelectionBoxでの複数ファイル選択は出来ない（忘れそう）
〇FileSelectionBoxでの開いた際の初期フォルダの指定は出来ない（忘れそう）
（excelのvbaでゴニョゴニョやる？代替えしてダイアログだけ流用？
　のようなテクニックはあるみたいだが・・・）