ライセンス無しでStepをエクスポートする

コンセプト的には、こちらの2個を足して2で割ったようなものです。
ﾗｲｾﾝｽ無しでSTLをCATIAに取り込む3(STLだけじゃない) - C#ATIA
D＆DでStep<->Iges相互変換するVBScript - C#ATIA

えー経緯から申し上げると、弊社は予算の都合上、長年StepとParaSolid
の受け入れが苦手でした。（ネイティブファイル以外は主にIgesです）
それが一番の理由で、無償の3DCADのコンバーターソフトを見つけては
ご紹介しています。
当ブログでも、Fusion360もスタートはコンバーターとしての検証でした。

CATIA V5のStepのライセンス（モジュール？）も、確か導入で2～30万で
保守費用が10％ぐらいだったはずです。・・・他を探す理由には十分です。

個人的にはFusion360の変換精度には不満が無いのですが、社内的に
"起動が遅い"との評価です。

で本題ですが、Step<->Iges相互変換するVBScriptを作ったのですが、
案外面倒だな・・と感じたので、直接エクスポートするマクロを
作ってみました。当然mayoのインストールは必要です。

'vba expot_step_via_mayo ver0.0.1 using KCL by kantoku
'mayo経由でStepをエクスポート

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 stpPath
    stpPath = get_export_path()
    If Len(stpPath) < 1 Then Exit Sub

    '一時的なIgesパス
    Dim tempIgesPath As String
    tempIgesPath = get_temp_iges_path(stpPath)
    
    'Igesエクスポート設定バックアップ
    Dim igesSettings As Variant
    igesSettings = get_iges_setting()
    Call dump(Join(igesSettings, " : "))

    'Igesエクスポート設定 Bスプライン-ソリッド
    Call set_iges_setting(Array(1, 1))
    Call dump(Join(igesSettings, " : "))

    'Igesエクスポート
    CATIA.ActiveDocument.ExportData tempIgesPath, "igs"
    If Not is_exists(tempIgesPath) Then
        MsgBox "エクスポートに失敗しました"
        Exit Sub
    End If

    'Iges->Step
    Call exec_convert_by_mayo( _
        tempIgesPath, _
        stpPath, _
        True _
    )

    'Igesエクスポート設定戻す
    Call set_iges_setting(igesSettings)
    Call dump(Join(igesSettings, " : "))

    MsgBox "Done"

End Sub


'一時的なIgesパス取得
Private Function get_temp_iges_path( _
    ByVal path As String) _
    As String

    Dim orignal As Variant
    orignal = split_path_name(path)

    get_temp_iges_path = get_unique_path( _
        join_path_name( _
            Array(orignal(0), orignal(1), "igs") _
        ) _
    )

End Function


'重複無しファイル名の取得
Private Function get_unique_path( _
    ByVal path As String) _
    As String

    Dim orignal As Variant
    orignal = split_path_name(path)

    Dim tmpPath As String
    tmpPath = path
    If Not is_exists(tmpPath) Then
        get_unique_path = tmpPath
        Exit Function
    End If

    Dim i As Long
    i = 0
    Do
        i = i + 1
        tmpPath = join_path_name( _
            Array(orignal(0), orignal(1) & "_" & i, orignal(2)) _
        )
        If Not is_exists(tmpPath) Then
            get_unique_path = tmpPath
            Exit Function
        End If
    Loop

End Function


'Iges設定の設定
Private Sub set_iges_setting( _
    ByVal igesSettings As Variant)

    Dim igsSetAtt As IgesSettingAtt
    Set igsSetAtt = CATIA.SettingControllers.Item("CATIdeIgesSettingCtrl")

    '標準,Bスプライン
    igsSetAtt.crvMod = igesSettings(0)
    igsSetAtt.SaveRepository

    'サーフェス,ソリッド
    igsSetAtt.ExportMSBO = igesSettings(1)
    igsSetAtt.SaveRepository

End Sub


'Iges設定の取得
Private Function get_iges_setting() _
    As Variant

    Dim igsSetAtt As IgesSettingAtt
    Set igsSetAtt = CATIA.SettingControllers.Item("CATIdeIgesSettingCtrl")

    '標準,Bスプライン
    Dim crvMod As Long
    crvMod = igsSetAtt.crvMod

    'サーフェス,ソリッド
    Dim expMSBO As Long
    expMSBO = igsSetAtt.ExportMSBO

    
    get_iges_setting = Array(crvMod, expMSBO)
    
End Function


'エクスポートファイルパス
Private Function get_export_path() _
    As String

    Dim tmpPath As Variant
    Dim msg As String

    Do
        get_export_path = CATIA.FileSelectionBox( _
            "メッシュファイルの選択", _
            "*.stp;*step", _
            CatFileSelectionModeSave _
        )

        If Len(get_export_path) < 1 Then Exit Function

        If is_exists(get_export_path) Then
            tmpPath = split_path_name(get_export_path)
            msg = tmpPath(1) & "." & tmpPath(2) & "は既に存在します。" & vbCrLf & _
            "上書きしますか?"
            
            If MsgBox(msg, vbYesNo + vbExclamation, "上書き確認") = vbYes Then
                Exit Function
            End If
        Else
            Exit Function
        End If
    Loop
    
End Function


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

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

    'doc type check
    If Not KCL.CanExecute( _
        Array( _
            "PartDocument,ProductDocument" _
            ) _
        ) Then
        can_execute = False
    End If

End Function


'mayoで変換
'extension-変換後拡張子
'removeFile-変換後元ファイルの削除
Private Function exec_convert_by_mayo( _
    ByVal importPath As String, _
    ByVal exportPath As String, _
    Optional ByVal removeFile = False) _
    As String

    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 As Object
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run cmd, vbNormalFocus, True
    
    If is_exists(exportPath) Then
        exec_convert_by_mayo = exportPath
    Else
        exec_convert_by_mayo = ""
    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

mayoはこちらです。
GitHub - fougue/mayo: 3D CAD viewer and converter based on Qt + OpenCascade

又、こちらの自作ライブラリの同一プロジェクト内に入れておく必要が
有ります。
GitHub - kantoku-code/KCL: CATIA Library for personal CATVBA (CATIA macro)

作ったものの、使うかな・・・。