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