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

C#ATIA

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

インプロセス実行時、一部をアウトプロセスで実行

KCLには言語判定の関数 "GetLanguage" 関数を入れているのですが、
最近になって打率が悪いことに気が付きました。
判定できない原因の一つが、マクロ自身をインプロセスで実行した際に
ステータスバーの文字を取得する前に、判定しているような気がしています。

その為、インプロセス実行時にも一部のマクロをアウトプロセスで実行する方法が
無いかな? と思いテストしてみました。


こちらは、ベースとなるコードです。

'vba using-'KCL0.09'
Sub CATMain()
    Dim Hb As HybridBody: Set Hb = KCL.SelectItem("Select", "HybridBody")
    Call SelCrv(Hb)
    MsgBox "Done"
End Sub

Sub SelCrv(Prm)
    Dim Hb As HybridBody
    Set Hb = Prm
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    Sel.Clear
    
    Dim HS As HybridShape
    For Each HS In Hb.HybridShapes
        Sel.add HS
    Next
End Sub

マクロ実行後、指定した形状セット内の点・線・面を選択した状態で
終了するだけの無意味なコードです。

インプロセスな実行とアウトプロセスな実行の違いは、マクロ実行時にCATIA自身を
操作できるか? 出来ないか? で判断することが出来ます。
・インプロセス - 操作出来ない
・アウトプロセス - 操作出来る(困っちゃう)

その為、形状セット内にソコソコ要素が入っているもので上記のコードを
実行した際、ズーム・ムーブ・スピン等の操作で簡単に判断できます。


インプロセス実行時に、一部のマクロをアウトプロセスで実行する方法は
幾つか有りそうな気がしていますが、外部にファイルを用意し
取り込んだ上で実行するのでは、色々な意味で手間がかかりそうな
気がしましたので没。

こちらで、imihitoさんにイロイロと教えて頂いた方法を利用し、
CATVBAの標準モジュールをマクロで削除したい (希望)2 - C#ATIA

こちらの方法と併用する事にしました。
外部のマクロを実行する3 - C#ATIA

要は、VBAの関数を文字として取得し、外部マクロとして実行する
と言うひねくれた方法です。
但し、これがアウトプロセスとして実行できるものかどうかは、
実際に実行するまではわかりません。


また、VBAプロジェクト内のコードを文字として取得する方法は、
こちらのサンプルが非常に参考になりました。
モジュール内のコードを操作する(CodeModule オブジェクトのプロパティ) | ExcelWork.info

'vba using-'KCL0.09'
'参考 http://excelwork.info/excel/codemoduleproperty/
Sub CATMain()
    '*** VBE準備 ***
    Dim VbPjName$: VbPjName = "Using_KCL_Sample"    'プロジェクト名
    Dim VbCpName$: VbCpName = "Test_Func_Evaluate"  'モジュール名
    Dim VbFcName$: VbFcName = "SelCrv"              '関数名

    'VBE
    Dim Vbe As Object: Set Vbe = GetVBE()
    If KCL.IsNothing(Vbe) Then Exit Sub
    
    'VBProject
    Dim Pj As Object: Set Pj = GetVBProject(VbPjName, Vbe)
    If KCL.IsNothing(Pj) Then Exit Sub
    
    'VBComponent
    Dim Cp As Object: Set Cp = GetVBComponent(VbCpName, Pj)
    If KCL.IsNothing(Cp) Then Exit Sub
    
    'CodeModule
    Dim Cm As Object: Set Cm = Cp.CodeModule
    
    'Component内のコード取得
    Dim Code$: Code = GetCode(VbFcName, Cm)
    If Code = vbNullString Then Exit Sub

    '*** CATIA ***
    '選択
    Dim Hb As HybridBody: Set Hb = KCL.SelectItem("Select", "HybridBody")
    
    '実行言語
    Dim SLang As CATScriptLanguage: SLang = CATVBALanguage
    
    '引数
    Dim Prm(0) As Variant: Set Prm(0) = Hb
    
    'SystemService
    Dim SS As Variant: Set SS = CATIA.SystemService
    
    '呼出し
    Call SS.Evaluate(Code, SLang, VbFcName, Prm)
    
    MsgBox "Done"
End Sub

'アウトプロセス用マクロ
Sub SelCrv(Prm)
    Dim Hb As HybridBody
    Set Hb = Prm
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    Sel.Clear
    
    Dim HS As HybridShape
    For Each HS In Hb.HybridShapes
        Sel.add HS
    Next
End Sub

'Code取得
Private Function GetCode(ByVal FancName$, ByVal Cm As Object) As String
    GetCode = vbNullString
    On Error Resume Next
        With Cm
            Dim Start&: Start = .ProcStartLine(FancName, 0) '開始行
            Dim Count&: Count = .ProcCountLines(FancName, 0) '文字数
            GetCode = .Lines(Start, Count)
        End With
    On Error GoTo 0
    If GetCode = vbNullString Then
        MsgBox "関数 ' " & FancName & " ' が取得できませんでした"
    End If
End Function

'VBComponent取得
Private Function GetVBComponent(ByVal Name$, ByVal Pj As Object) As Object
    On Error Resume Next
        Set GetVBComponent = Pj.VBComponents.Item(Name)
    On Error GoTo 0
    If KCL.IsNothing(GetVBComponent) Then
        MsgBox "VBComponent ' " & Name & " ' が取得できませんでした"
    End If
End Function

'VBProject取得
Private Function GetVBProject(ByVal Name$, ByVal Vbe As Object) As Object
    On Error Resume Next
        Set GetVBProject = Vbe.VBProjects.Item(Name)
    On Error GoTo 0
    If KCL.IsNothing(GetVBProject) Then
        MsgBox "VBProject ' " & Name & " ' が取得できませんでした"
    End If
End Function

'VBEditor取得
'Special_Thx Mr.imihito
Private Function GetVBE() As Object
    Set GetVBE = Nothing
    
    'VBAのバージョンチェック
    Dim COMObjectName$
    #If VBA7 Then
        COMObjectName = "MSAPC.Apc.7.1"
    #ElseIf VBA6 Then
        COMObjectName = "MSAPC.Apc.6.2"
    #Else
        MsgBox "VBAのバージョンが未対応です"
        Exit Function
    #End If
    
    'APC取得
    Dim oApc As Object: Set oApc = Nothing
    On Error Resume Next
        Set oApc = CreateObject(COMObjectName)
    On Error GoTo 0
    
    'VBE取得
    If KCL.IsNothing(oApc) Then
        MsgBox "MSAPC.Apcが取得できませんでした"
        Exit Function
    End If
    
    Set GetVBE = oApc.Vbe
End Function

もし試される方がいるようでしたら、プロジェクト名・モジュール名については
各々の環境にあわせた名称に変更する必要があります。

これをインプロセスで実行すると…、無事実行中でもCATIAの操作が可能でした。
当時 "こんなの無意味" ぐらいの事を書きましたが、利用方法があるん
ですね。 以前試しておいて良かった。