Parasolidのｲﾝﾎﾟｰﾄｴﾗｰを修復するVBS

少しづつ時間が確保出来たので、こちらを真剣に調べてみました。
結果的に・・・　どうやらｽﾍﾟｰｽ文字だったようです。
(使用したｴﾃﾞｨﾀではｽﾍﾟｰｽ文字が上手く検索できなかったのかな･･･)

2件続いた事例を考えると、小数点直後のｽﾍﾟｰｽ文字が原因だった為
それらを削除する為のVBScriptを作成しました。

Language = "VBSCRIPT"
'*********************************
'RepairX_TFile.vbs ver 0.0.1
'不要なｽﾍﾟｰｽ文字によるｲﾝﾎﾟｰﾄｴﾗｰとなるParasolidﾌｧｲﾙを修復
'*********************************

'*** 設定 変更しないで下さい ***
Const BeforeKey = ". "
Const AfterKey = "."
'***

Call Main
wscript.Quit 0

'*********************************
Sub Main()
    'D&D
    Dim DDlist 'As Variant
    DDlist = GetDropList(wscript.Arguments)
    If Not IsArray(DDlist) Then Exit Sub

    '確認
    Dim DDlistStr 'as String

    Dim Msg 'As String
    Msg = "以下のﾌｧｲﾙをﾁｪｯｸします。よろしいですか？" + vbNewLine + _
      DDList2String(DDlist)
    If MsgBox(Msg, vbYesNo) = vbNo Then Exit Sub

    '処理
    Msg = ExecReplace(DDlist, BeforeKey, AfterKey)
    If Msg = vbNullString Then
        MsgBox "修正したﾌｧｲﾙはありませんでした"
    Else
        MsgBox Msg + "の修正したﾌｧｲﾙを作成しました"
    End If
End Sub

Private Function ExecReplace(ByVal Ary, ByVal Before, ByVal After)
    Dim i, Msg
    Msg = vbNullString
    For i = 0 To UBound(Ary)
        If IsCreateNewX_T(Ary(i), Before, After) Then
            Msg = Msg + Ary(i) + vbNewLine
        End If
    Next
    ExecReplace = Msg
End Function

Private Function IsCreateNewX_T(ByVal Path, ByVal Before, ByVal After)
    IsCreateNewX_T = False
    Dim txt
    txt = ReadFile(Path)
    If InStr(1, txt, Before) < 1 Then
        Exit Function
    End If
    
    Dim NewPath
    NewPath = GetNewName(Path)
    txt = Replace(txt, Before, After)
    Call WriteFile(NewPath, txt)
    IsCreateNewX_T = True
End Function

' *** D&D ***
'ﾄﾞﾛｯﾌﾟ処理
Private Function GetDropList(ByVal Args) 'As Variant
    Dim ArgsCount 'As Long
    ArgsCount = Args.Count
    If ArgsCount < 1 Then
        MsgBox "x_tﾌｧｲﾙ(ﾊﾟﾗｿﾘｯﾄﾞ)をD&Dして下さい"
        Exit Function
    End If

    Dim i 'As Long
    Dim X_tList() 'As Variant
    ReDim X_tList(ArgsCount)
    Dim X_tCount 'As Long
    X_tCount = -1
    Dim Path 'As Variant
    Dim ArgsPath 'As String
	
    'ContinueかGoto使いたかった･･･
    For i = 1 To ArgsCount
        ArgsPath = Args(i - 1)
        If IsExists(ArgsPath) Then
            Path = SplitPathName(ArgsPath)
            If Isx_tFile(Path(2)) Then
                X_tCount = X_tCount + 1
                X_tList(X_tCount) = JoinPathName(Path)
            End If
        End If
    Next
	
    If X_tCount < 0 Then
        Msg = "ﾁｪｯｸするx_tﾌｧｲﾙ(ﾊﾟﾗｿﾘｯﾄﾞ)がありません!"
        MsgBox Msg, vbOKOnly
        Exit Function
    End If
    ReDim Preserve X_tList(X_tCount)
    GetDropList = X_tList
End Function

'Parasolidﾁｪｯｸ　拡張子のみ
Private Function Isx_tFile(ByVal Ext) 'As Boolean
    Isx_tFile = False
    If UCase(Ext) = "X_T" Then Isx_tFile = True
End Function

'ﾘｽﾄのﾌｧｲﾙﾒｲのみ取得
Private Function DDList2String(ByVal DDlist) 'As Boolean
    Dim Ts, ToStr, i
    ToStr = ""
    For i = 0 To UBound(DDlist)
        Ts = SplitPathName(DDlist(i))
        ToStr = ToStr + Ts(1) + "." + Ts(2) + vbNewLine
    Next
    DDList2String = ToStr
End Function


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

'ﾊﾟｽ/ﾌｧｲﾙ名/拡張子 分割
'Return: 0-Path 1-BaseName 2-Extension
Private Function SplitPathName(ByVal FullPath) 'As Variant
    Dim Path(2) 'As String
    With GetFSO
        Path(0) = .getParentFolderName(FullPath)
        Path(1) = .GetBaseName(FullPath)
        Path(2) = .GetExtensionName(FullPath)
    End With
    SplitPathName = Path
End Function

'ﾊﾟｽ/ﾌｧｲﾙ名/拡張子 連結
Private Function JoinPathName(ByVal Path) 'As String
    If Not IsArray(Path) Then Stop '未対応
    If Not UBound(Path) = 2 Then Stop '未対応
    JoinPathName = Path(0) + "\" + Path(1) + "." + Path(2)
End Function

'ﾌｧｲﾙの有無
Private Function IsExists(ByVal Path) 'As Boolean
    IsExists = GetFSO.FileExists(Path)
End Function

'ﾌｧｲﾙ読み込み
Private Function ReadFile(ByVal Path) 'As Variant
    With GetFSO.GetFile(Path).OpenAsTextStream
        ReadFile = .ReadAll
        .Close
    End With
End Function

'ﾌｧｲﾙ書き込み
Private Sub WriteFile(ByVal Path, ByVal txt)
    With GetFSO.OpenTextFile(Path, 2, True)
        .Write txt
        .Close
    End With
End Sub

'重複しない名前取得
''' @param:Path-ﾌｧｲﾙﾊﾟｽ
''' @return:新たなﾌｧｲﾙﾊﾟｽ
Private Function GetNewName(ByVal OldPath)
    Dim Path
    Path = SplitPathName(OldPath)
    Path(2) = "." & Path(2)
    Dim NewPath
    NewPath = Path(0) + "\" + Path(1)
    If Not IsExists(NewPath + Path(2)) Then
        GetNewName = NewPath + Path(2)
        Exit Function
    End If
    Dim TempName, i
    i = 0
    Do
        i = i + 1
        TempName = NewPath + "_" + CStr(i) + Path(2)
        If Not IsExists(TempName) Then
            GetNewName = TempName
            Exit Function
        End If
    Loop
End Function

・複数ﾌｧｲﾙをD&Dすることが可能です。
・処理後のﾌｧｲﾙはD&Dしたファイルと同一ﾌｫﾙﾀﾞ内に、
　「元のﾌｧｲﾙ名」+「＿数字」+「.x_t」ﾌｧｲﾙが出来上がり、元のﾌｧｲﾙを上書きは
　行いません。
・過去の事例から、小数点直後に不要なｽﾍﾟｰｽ文字が入っていたため
　そのｽﾍﾟｰｽ文字を削除しているだけです。
　ｲﾝﾎﾟｰﾄｴﾗｰの全ての原因を修復する為のものでは有りません。

正直な所、客先のﾒｰﾙ環境が原因のような気がするので、他人には全く役立たない
様な気がしてます。

週末この暑さの中、ｸﾞﾗﾝﾄﾞを駆け回って疲労感たっぷりの月曜日に作っている為
不要な関数等が残っているかも････。

C#ATIA

↑ﾀｲﾄﾙ詐欺　主にFusion360API　偶にCATIA V5 VBA(絶賛ネタ切れ中)

Parasolidのｲﾝﾎﾟｰﾄｴﾗｰを修復するVBS