C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

D&DでStep<->Iges相互変換するVBScript

タイトルが異なりますが、こちらの続きです。
続mayo - C#ATIA
世間の皆様は、既に盆休みですね。

コマンドラインで実行出来るということは、スクリプト等で処理出来ます。
と言うことで、ファイルをD&Dすることで
・Step->Iges
・Iges->Step
に変換するVBScriptを作成しました。

'step2iges_mayo.vbs
'D&Dでstep<->iges相互変換スクリプト

Language = "VBSCRIPT"

'*** 正しく設定して下さい ***
'こちらのソフトを事前にインストールしてください
'https://github.com/fougue/mayo

'mayoの実行ファイルパス
Const MAYO_PATH = "C:\Program Files\Fougue\Mayo\mayo.exe"
'***

'*** 設定 変更しないで下さい ***
Const vbHide = 0 'ウィンドウを非表示
Const vbNormalFocus = 1 '通常のウィンドウで、最前面のウィンドウ
Dim EXTENSION_IGES_LIST
EXTENSION_IGES_LIST = Array("igs", "iges")
Dim EXTENSION_STEP_LIST
EXTENSION_STEP_LIST = Array("stp", "step")
'***

Call Main
WScript.Quit 0

'*********************************
Sub Main()

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

    'D&D
    Dim dropFiles 'As Variant
    dropFiles = get_drop_files(WScript.Arguments)
    If Not IsArray(dropFiles) Then
        Exit Sub
    End If

    '確認
    Dim names
    names = drop_files_to_string(dropFiles)

    Dim msg
    msg = "以下のファイルを変換します。宜しいですか?" & vbCrLf & names
    If MsgBox(msg, vbOKCancel + vbQuestion, "確認") = vbCancel Then Exit Sub

    '処理
    convert_files (dropFiles)

    'fin
    MsgBox ("Done")
End Sub


Private Sub convert_files(ByVal paths)
    Dim objShell
    Set objShell = CreateObject("WScript.Shell")

    Dim exPath, i
    For i = 0 To UBound(paths)
        exPath = get_unique_path(paths(i))

        cmd = _
            Chr(34) & MAYO_PATH & Chr(34) & " " & _
            Chr(34) & paths(i) & Chr(34) & " " & _
            " --export " & Chr(34) & exPath & Chr(34)
        objShell.Run cmd, vbNormalFocus, True

    Next
End Sub


Private Function get_unique_path(ByVal path)
    Dim orignal
    orignal = split_path_name(path)

    Dim ext
    If is_iges(path) Then
        'iges->step
        ext = EXTENSION_STEP_LIST(0)
    Else
        'step->iges
        ext = EXTENSION_IGES_LIST(0)
    End If

    tmpPath = join_path_name(Array(orignal(0), orignal(1), ext))
    If Not is_exists(tmpPath) Then
        get_unique_path = tmpPath
        Exit Function
    End If

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

End Function


'ドロップ処理
Private Function get_drop_files(ByVal args) 'As Variant
    Dim argsCount 'As Long
    argsCount = args.count
    If argsCount < 1 Then
        Call show_click_message
        Exit Function
    End If

    Dim i 'As Long
    Dim files() 'As Variant
    ReDim files(argsCount)
    Dim count 'As Long
    count = -1
    Dim argsPath 'As String

    For i = 1 To argsCount
        argsPath = args(i - 1)
        If is_exists(argsPath) Then
            If is_iges(argsPath) Or is_step(argsPath) Then
                count = count + 1
                files(count) = argsPath
            End If
        End If
    Next

    If count < 0 Then
        MsgBox "変換するべきファイルがありませんでした。(IgesまたはStepファイルが必要です)"
        get_drop_files = enpty
    Else
        ReDim Preserve files(count)
        get_drop_files = files
    End If
    
End Function


'Stepファイルか
Private Function is_step(ByVal path)
    pathInfo = split_path_name(path)
    is_step = in_list(pathInfo(2), EXTENSION_STEP_LIST)
End Function


'Igesファイルか
Private Function is_iges(ByVal path)
    pathInfo = split_path_name(path)
    is_iges = in_list(pathInfo(2), EXTENSION_IGES_LIST)
End Function


'リスト内に含まれるか - 大小文字区別なし
Private Function in_list(ByVal txt, ByVal lst)
    in_list = False
    Dim i
    For i = 0 To UBound(lst)
        If LCase(txt) = LCase(lst(i)) Then
            in_list = True
            Exit Function
        End If
    Next
End Function


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

End Function


'リストのファイルメイのみ取得
Private Function drop_files_to_string(ByVal dropFiles) 'As Boolean
    Dim pathInfo, names, i
    For i = 0 To UBound(dropFiles)
        pathInfo = split_path_name(dropFiles(i))
        names = names & pathInfo(1) & "." & pathInfo(2) & vbNewLine
    Next
    drop_files_to_string = names
End Function


' 使い方
Private Sub show_click_message()
    Dim msg
    msg = "Igesファイル、又はStepファイルをドラッグ&ドロップして下さい。"

    MsgBox msg
End Sub

' *** 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

mayoの実行ファイルパスを正しく設定してください。
(現在はWinのデフォルトインストールパスです)

Step又はIgesをD&Dしてください。元のフォルダと同じフォルダに変換後の
ファイルが出来上がります。

・複数ファイルのD&DでもOKです。
・混在していてもOKです。
・変換後のファイル名は元のファイル名と同じです。
・変換後のファイル名が重複する場合は、ファイル名に"_(ナンバリング)"の
 名前となります。※上書きはしません