C#ATIA

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

形状セット内の線の長さをExcelシートに出力する

こちらの続きです。
形状セット内の線の長さを表示する - C#ATIA


前回の結果を「Excelのシートに出力したい」と言うことなので
コードを変更しました。

'vba GetCurvesLength_ToExcel
Sub CATMain()
    '選択
    Dim Msg$: Msg = "形状セットを選択して下さい"
    Dim SelItem As SelectedElement: Set SelItem = SelectItem(Msg, Array("HybridBody"))
    If IsNothing(SelItem) Then Exit Sub
    Dim HBody As HybridBody: Set HBody = SelItem.Value
    
    'Partの取得
    Dim Pt As Part: Set Pt = GetParent_Of_T(HBody, "Part")
    
    'HybridShapeFactory取得 - 形状判定の為必要
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    
    '形状セット内の直線・円弧・スプラインを取得
    Dim HSps As HybridShapes: Set HSps = HBody.HybridBodies
    Dim Hsp As HybridShape
    Dim CurveRefs As New Collection
    Dim Ref As Reference
    Dim GeoType&
    For Each Hsp In HSps
        Set Ref = Pt.CreateReferenceFromObject(Hsp)
        GeoType = Fact.GetGeometricalFeatureType(Ref)
        'AutomationManualの記述が間違えやすいが、
        '2-Curve , 3-Line , 4-Circle になる
        If GeoType >= 2 And GeoType <= 4 Then
            Call CurveRefs.Add(Ref)
        End If
    Next
    
    'Excelのシートを取得
    Dim Sheet As Object: Set Sheet = GetExcelSheet
    If IsNothing(Sheet) Then Exit Sub
    
    '測定しつつExcelに書き込み
    Dim CurveLeng#
    Dim I&
    For I = 1 To CurveRefs.Count
        CurveLeng = Pt.Parent.GetWorkbench("SPAWorkbench") _
                             .GetMeasurable(CurveRefs(I)).Length
        Sheet.Cells(I, 1) = CurveRefs(I).DisplayName
        Sheet.Cells(I, 2) = CurveLeng
    Next
    
    '終了
    MsgBox "End"
    DoEvents
    AppActivate "Microsoft Excel"
End Sub

'起動中のExcelのアクティブブックのアクティブシートを取得
Private Function GetExcelSheet() As Object
    On Error Resume Next
        Dim Xls As Object
        Set Xls = GetObject(, "Excel.Application")
        Set GetExcelSheet = Xls.ActiveSheet
    On Error GoTo 0
    Err.Clear
End Function

GetExcelSheet関数を新たに作成し、CATMainを少し変更しました。
(他の関数はそのままです)
Excel側のチェックはあまりしていない(強制的に上書きしたり、不要なものを
削除したり)ので、実際に使う際はもうちょっとチェックを入れたほうが
安全かと思います。

実行結果はこんな感じです。
(事前にエクスポートされるBookを開いておく必要があります)
f:id:kandennti:20160526123955p:plain
恐らく確認を直ぐに行いたいはずなので、MsgBox表示後はExcel
アクティブになるようにしています。