読者です 読者をやめる 読者になる 読者になる

C#ATIA

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

Space-eネイティブファイルをSatファイルにD&Dで変換するスプリクト

イロイロと紆余曲折ありまして、Space-eをバージョンアップしVer5.5が
使える事になりました。 時間が無いのであまり触っていませんが。

僕は予定が無いのですが、Space-eネイティブファイル(.mdp)をACISファイルに
変換したいと言うお話が社内にありまして、どうせならCADの
オペレーションを奪われないように、バッチ処理で変換する方法が無いものか
と思い、サポートに問い合わせたのですが "出来ません" との
回答を頂きました。(Space-eはACISカーネルです)

"そんな事、無いだろう" と思い、インストールフォルダ内を検索したところ・・・
ごめんなさい、アッサリ見付けてしまいました。

このままではちょっと使いにくい為、D&Dして変換できるような
VBスプリクトを作成してみました。
変換を行う実行ファイルまでのパスは、各PC毎に設定する必要があります。
(M2S_PATH定数です)
又、当然ながらライセンスは必要です。

'vbs mdp2sat.vbs
'Space-eVer5.5 D&Dでmdp→sat変換するスプリクト ver0.0.2
Option Explicit

'*************************
'PC毎に設定-デフォルトインストールであれば変更不要
Private Const M2S_PATH = "C:\HZS\Modeler\dmu\bin\MdpToSat.exe"
'*************************
'設定-イジラナイデ
Private Const PROSFOLDRNAME = "心当たりがない場合は削除してください" '作業フォルダ名
Private Const BATCHHAEDER = "このファイルはバッチ確認用のファイルです。心当たりがない場合は削除して結構です。"
Private Const DAMMYFILENAME = "temp.txt" 'ダミーファイル名
Private Const FILENAMEFOOTER = "_Layer_" '変換ファイルフッター
'*************************

Call Main

Sub Main()
    'D&D
    Dim Args: Set Args = WScript.Arguments
    If Not Drop(Args) Then Exit Sub
    
    'Speチェック
    If Not IsSpacee Then Exit Sub
    
    'Mdpファイルフィルタ
    Dim MdpAry: MdpAry = GetMdpFileAry(Args)
    If IsEmpty(MdpAry) Then
        MsgBox "Mdpファイルがありませんでした"
        Exit Sub
    End If
    
    '作業フォルダ(削除チェック用)
    Dim ProcessFolder: ProcessFolder = GetProcessFolderName(Args(0))
    
    '作業中チェック
    If Not CanExecute(ProcessFolder) Then Exit Sub
    
    '変換後ファイル名取得
    Dim SatAry: SatAry = GetSatName(MdpAry)
    
    '変換バッチコード取得
    Dim ConvCodes: ConvCodes = GetConvertCode(MdpAry, SatAry, ProcessFolder)
    
    '作業フォルダ作成 ダミー作成
    Call GetFSO.CreateFolder(ProcessFolder)
    Call CreateDammyFile(ProcessFolder)
    
    'バッチファイル作成 - 実行
    Call BatchExecute(ConvCodes, ProcessFolder)
    
    'ダミー削除
    Call GetFSO.DeleteFile(ProcessFolder & "\" & DAMMYFILENAME)
    
    'バッチ終了チェック
    Dim Fd: Set Fd = GetFSO.GetFolder(ProcessFolder)
    Do
        WScript.Sleep 100
        If Fd.Files.Count < 1 Then Exit Do
    Loop
    
    '作業フォルダ削除
    Call GetFSO.DeleteFolder(ProcessFolder)
    
    '終了
    MsgBox "元ファイル " & CStr(UBound(MdpAry) + 1) & "個分のファイルを変換しました"
End Sub

'Space-eチェック
Private Function IsSpacee()
    IsSpacee = IsExists(M2S_PATH)
    If Not IsSpacee Then
        MsgBox M2S_PATH & vbNewLine & _
               "が見つかりません。 パスを再設定してください"
    End If
End Function

'実行
Private Sub BatchExecute(ByVal Codes, ByVal ProsPath)
    Dim Cnt: Cnt = UBound(Codes)
    Dim Ws: Set Ws = CreateObject("WScript.Shell")
    Dim i, Path
    For i = 0 To Cnt
        Path = ProsPath & "\" & CStr(i) & ".bat"
        Call WriteFile(Path, Codes(i))
        Ws.Run Path
    Next
    Set Ws = Nothing
End Sub

'ダミー作成
Private Sub CreateDammyFile(ByVal Path)
    Call WriteFile(Path & "\" & DAMMYFILENAME, BATCHHAEDER)
End Sub

'変換バッチコード
Private Function GetConvertCode(ByVal MdpAry, ByVal SatAry, ByVal ProsPath)
    Dim Cnt: Cnt = UBound(MdpAry)
    Dim Codes(): ReDim Codes(Cnt)
    Dim Path
    Dim i
    For i = 0 To Cnt
        Path = SplitPathName(SatAry(i))
        Codes(i) = "rem " & BATCHHAEDER & vbNewLine & _
                   "mkdir " & Path(0) & vbNewLine & _
                   M2S_PATH & " " & MdpAry(i) & " " & SatAry(i) & vbNewLine & _
                   "del " & ProsPath & "\" & CStr(i) & ".bat"
    Next
    GetConvertCode = Codes
End Function

'変換後ファイル名
Private Function GetSatName(ByVal MdpAry)
    Dim Cnt: Cnt = UBound(MdpAry)
    Dim SatAry(): ReDim SatAry(Cnt)
    Dim i
    For i = 0 To Cnt
        SatAry(i) = GetNewFolderName(GetRemoveExtensionPath(MdpAry(i)) & ".sat")
    Next
    GetSatName = SatAry
End Function

'作業フォルダパス取得
Private Function GetProcessFolderName(ByVal Path)
    Dim TmpPath: TmpPath = SplitPathName(Path)
    GetProcessFolderName = TmpPath(0) & "\" & PROSFOLDRNAME
End Function

'実行確認
Private Function CanExecute(ByVal Path)
    Dim Exi: Exi = IsExists(Path)
    If Exi Then
        Dim Msg
        Msg = "変換の処理中の可能性があります。" & vbNewLine & _
              "変換処理が終了してから再度行ってください。" & vbNewLine & _
              "万一、変換処理が終了している場合は、手動で" & vbNewLine & _
              "「" & Path & "」" & vbNewLine & _
              "フォルダを削除してください。"
        MsgBox Msg
    End If
    CanExecute = Not Exi
End Function

'Mdpリスト
Private Function GetMdpFileAry(ByVal InAry)
    GetMdpFileAry = Empty
    Dim ExAry(): ReDim ExAry(InAry.Count)
    Dim Cnt: Cnt = -1
    Dim i, Path, Ext
    For i = 0 To InAry.Count - 1
        Path = SplitPathName(InAry(i))
        Ext = UCase(Path(2))
        If Ext = "MDP" And IsExists(InAry(i)) Then
            Cnt = Cnt + 1
            ExAry(Cnt) = InAry(i)
        End If
    Next
    If Cnt < 0 Then Exit Function
    ReDim Preserve ExAry(Cnt)
    GetMdpFileAry = ExAry
End Function

'ドロップ
Private Function Drop(List)
    If List.Count = 0 Then
        Dim Msg
        Msg = "MdpファイルをD&Dしてください"
        MsgBox Msg
        Drop = False
    Else
        Drop = True
    End If
End Function

'*** IO ***
'FSO
Private Function GetFSO()
    Set GetFSO = CreateObject("Scripting.FileSystemObject")
End Function

'ファイル有無
Private Function IsExists(ByVal Path)
    IsExists = False
    Dim FSO: Set FSO = GetFSO
    If FSO.FileExists(Path) Then
        IsExists = True 'ファイル
    ElseIf FSO.FolderExists(Path) Then
        IsExists = True 'フォルダ
    End If
    Set FSO = Nothing
End Function

'ファイル名
Private Function SplitPathName(ByVal FullPath)
    Dim Path(2)
    Dim FSO: Set FSO = GetFSO
    With FSO
        Path(0) = .GetParentFolderName(FullPath)
        Path(1) = .GetBaseName(FullPath)
        Path(2) = .GetExtensionName(FullPath)
    End With
    SplitPathName = Path
    Set FSO = Nothing
End Function

'書き出し
Private Sub WriteFile(ByVal Path, ByVal Txt)
    Call GetFSO.OpenTextFile(Path, 2, True).Write(Txt)
End Sub

'重複しない名前取得 拡張子は新しいもので投げて
Private Function GetNewFolderName(ByVal OldPath)
    Dim Path: Path = SplitPathName(OldPath)
    Dim NewPath: NewPath = Path(0) & "\" & Path(1)
    Dim TempName: TempName = NewPath
    If Not IsExists(TempName) Then
        GetNewFolderName = TempName & "\" & Path(1) & FILENAMEFOOTER & "." & Path(2)
        Exit Function
    End If
    Dim i: i = 0
    Do
        i = i + 1
        TempName = NewPath + "_" & CStr(i)
        If Not IsExists(TempName) Then
            GetNewFolderName = TempName & "\" & Path(1) & FILENAMEFOOTER & "." & Path(2)
            Exit Function
        End If
    Loop
End Function

'拡張子無しのパス
Private Function GetRemoveExtensionPath(ByVal Path)
    Dim TmpPath: TmpPath = SplitPathName(Path)
    GetRemoveExtensionPath = TmpPath(0) & "\" & TmpPath(1)
End Function

'*************************
'ver0.0.1 17.01.13 完成
'ver0.0.2 17.01.16 Space-eチェック追加 各ファイルをフォルダ内に変換
'*************************

上記のコードを拡張子 "vbs" のファイル名で保存して頂いて、Space-eネイティブファイル
D&Dして頂ければ、D&Dしたファイルと同一フォルダ内にファイルと同じ名前の
フォルダを製作した上でSatファイルに変換します。(複数ファイルをD&DしてもOKです)

但し、ちょっとイマイチなんです。 変換後のファイルは各クラス(レイヤー・レベル)毎に
なってしまい、大量のファイルになってしまいます。
(これ以上の方法がわかりません)

と、ここまではSpace-eユーザー以外は興味も湧かないお話です。


ここからは、自分自身で忘れてしまいそうなので覚書です。
上記のコードは複数ファイルの同時変換した後に "終わったよ" とダイアログを
表示させています。 つまりバッチ処理の終了を認識しています。
(要は、外部プログラムの終了を認識しています)

バッチ処理の終了を認識する方法は、他にもあるだろうと思いますが
以下の方法で行っています。

まず、WScript.ArgumentsでD&Dされた全ファイルパスを取得します。
続いて作業用の一時フォルダを作成し、ちょっと訳があってダミーファイルを
一時フォルダ内に作成します。

その後、一時フォルダ内に全ファイル数分の変換用バッチファイルを作成し、
即、実行させています。 バッチファイルの中身はこんな感じです。
(ファイル名は 0.bat と仮定しておきます)

rem このファイルはバッチ確認用のファイルです。心当たりがない場合は削除して結構です。
mkdir C\temp\hoge
C:\HZS\Modeler\dmu\bin\MdpToSat.exe C\temp\hoge.mdp C\temp\hoge\hoge_Layer_.sat
del C\temp\心当たりがない場合は削除してください\0.bat

最後の行ですが、自分自身を削除するようになっています。これにより
変換終了後はバッチファイルも削除されます。

続いて先程の "訳ありダミーファイル" を削除し、一時フォルダ内のファイル数を
0.1秒おきに監視します。 ファイル数が0となれば全ての変換が終了して
いる事になる為、一時フォルダを削除し終了となります。

実はこの "訳ありダミーファイル" を作成しないと、処理が速すぎる為なのか
上手く動作しなかったんですよ。こちらでも同様の手法です。
Space-e D&Dでファイル変換するスプリクト - C#ATIA