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

C#ATIA

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

線を選択しつつ、合計長さを表示する

CATIA_V5 VBA

こちらの続きです。
形状セット内の線の長さをExcelシートに出力する - C#ATIA



線を選択し続けながら、合計の長さを表示し、最後にExcel
出力します。

'vba GetCurvesLength_ToExcel2
Sub CATMain()
    Dim TotalLen#: TotalLen = 0# '合計の長さ

    'Partの取得
    Dim Doc As PartDocument: Set Doc = CATIA.ActiveDocument
    Dim Pt As Part: Set Pt = Doc.Part
    
    'HybridShapeFactory取得 - 形状判定の為必要
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    
    '選択
    Dim MsgBase$: MsgBase = "線を選択して下さい(選択終了:ESC)"
    Dim Msg$, Ref As Reference
    Dim CurveRefs As New Collection
    Do
        Msg = IIf(TotalLen = 0, MsgBase, MsgBase + " : 合計" + CStr(TotalLen) + "mm")
        Dim SelItem As SelectedElement: Set SelItem = SelectItem(Msg, Array("HybridShape"))
        If IsNothing(SelItem) Then Exit Do
        Set Ref = Pt.CreateReferenceFromObject(SelItem.Value)
        If IsCurve(Ref, Fact) Then
            Call CurveRefs.Add(Ref)
            TotalLen = TotalLen + GetLength(Ref, Pt)
        Else
            MsgBox "線(直線・円弧・スプライン)ではありません"
        End If
    Loop
    
    '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 = GetLength(CurveRefs(I), Pt)
        Sheet.Cells(I, 1) = CurveRefs(I).DisplayName
        Sheet.Cells(I, 2) = CurveLeng
    Next
    Sheet.Cells(CurveRefs.Count + 1, 1) = "合計"
    Sheet.Cells(CurveRefs.Count + 1, 2) = "=SUM(B1:B" + CStr(CurveRefs.Count) + ")"
    
    '終了
    MsgBox "End"
    DoEvents
    AppActivate "Microsoft Excel"
End Sub

'長さの取得
Private Function GetLength#(ByVal Ref As Reference, ByVal Pt As Part)
    GetLength = Pt.Parent.GetWorkbench("SPAWorkbench").GetMeasurable(Ref).Length
End Function

'線の判断
Private Function IsCurve(ByVal Ref As Reference, ByVal Fact As HybridShapeFactory) As Boolean
    Dim GeoType&: GeoType = Fact.GetGeometricalFeatureType(Ref)
    'AutomationManualの記述が間違えやすいが、
    '2-Curve , 3-Line , 4-Circle になる
    IsCurve = IIf(GeoType >= 2 And GeoType <= 4, True, False)
End Function

'起動中の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

'選択
''' @param:Msg-メッセージ
''' @param:Filter-選択フィルター(指定無し時AnyObject)
''' @return:AnyObject
Public Function SelectItem(ByVal Msg$, _
                           Optional ByVal Filter As Variant = Empty) _
                           As SelectedElement
    If IsEmpty(Filter) Then Filter = Array("AnyObject")
    Dim Sel As Variant: Set Sel = CATIA.ActiveDocument.Selection
    Sel.Clear
    Select Case Sel.SelectElement2(Filter, Msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select
    Set SelectItem = Sel.Item(1)
    Sel.Clear
End Function

'Nothing 書き方に統一感が無い為
''' @param:OJ-Variant(Of Object)
''' @return:Boolean
Public Function IsNothing(ByVal Oj As Variant) As Boolean
    IsNothing = Oj Is Nothing
End Function

マクロ実行時にはExcelのBookを開いた状態にしておく必要があります。

実行した際の最初は、ステータスバーの表示は
"線を選択して下さい(選択終了:ESC)"
となっていますが、
f:id:kandennti:20160628135107p:plain

1本選択後はステータスバーの最後の部分に、選択済みの線の合計長さが、
表示されます。
f:id:kandennti:20160628135117p:plain
イチイチMsgBoxを表示させるより、ストレス無く操作できるかと思います。

ESCキーで選択を終了し、Excel側に結果をエクスポート。
f:id:kandennti:20160628135125p:plain
画像のB6セルには "=SUM(B1:B5)" が入力され、選択された線の
合計を出しています。

正直に書くと、このマクロは同一の曲線を選択した際も、次々と
合計してしまうので、本来であれば重複選択を削除するための
処理が必要かと思われます。
直感的にはInternalNameを利用するのが良いのかな?と思います。
InternalNameテスト - C#ATIA


・・・お望みの形とちょっと違うかも知れません。




追記です。
スイマセン、前回のリンク先が違っていました。
又、コードと説明の画像が食い違う部分がありましたので、
修正しました。

前回のコードを流用し、Excel側だけですが合計を出すようにするには
①②の部分を書き足せば大丈夫だと思います。

    ・・・

    '測定しつつ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
    Sheet.Cells(CurveRefs.Count + 1, 1) = "合計" '①
    Sheet.Cells(CurveRefs.Count + 1, 2) = "=SUM(B1:B" + CStr(CurveRefs.Count) + ")" '②

    ・・・