↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)


指定した2D要素を、指定した原点位置でコピペする - C#ATIA



'vba sample_Comp2DExplode ver0.0.3

Option Explicit

Sub CATMain()
    If Not KCL.CanExecute("DrawingDocument") Then Exit Sub

    Dim ViewLst As Collection: Set ViewLst = GetExistComp2DView()
    If ViewLst.Count < 1 Then
        MsgBox "アクティブなシート内のアンロックされたビュー内には、" & vbNewLine & _
               "コンポーネント2Dが存在しませんでした", vbInformation
        Exit Sub
    End If
    Dim CompLst As Collection: Set CompLst = GetComp2DList(ViewLst)
    Dim Msg$: Msg = "アクティブなシートには" & _
                    CreateMsg(ViewLst, CompLst) & vbNewLine & _
                    "のコンポーネント2Dが存在します。 全て展開しますか?"
    If MsgBox(Msg, vbOKCancel + vbInformation) = vbCancel Then Exit Sub
    Call ExecuteExplode(CompLst)
    MsgBox "終了"
End Sub

Private Sub ExecuteExplode(ByVal CompLst As Collection)
    Dim Lst As Collection
    Dim Cmp As DrawingComponent
    Dim Sel As Selection: Set Sel = CATIA.ActiveDocument.Selection
    CATIA.HSOSynchronized = False
        For Each Lst In CompLst
            For Each Cmp In Lst
                Sel.Add Cmp
    CATIA.HSOSynchronized = True
End Sub

Private Function CreateMsg(ByVal ViewLst As Collection, _
                            ByVal CompLst As Collection) As String
    Dim Ary(): ReDim Ary(ViewLst.Count)
    Dim i&
    For i = 1 To ViewLst.Count
        Ary(i) = "ビュー '" & ViewLst(i).Name & "' - " & _
                    CStr(CompLst(i).Count) & "個"
    CreateMsg = Join(Ary, vbNewLine)
End Function

Private Function GetComp2DList(ByVal ViewLst As Collection) As Collection
    Set GetComp2DList = Nothing
    Dim Vw As DrawingView
    Dim Lst As Collection: Set Lst = New Collection
    For Each Vw In ViewLst
        Lst.Add DeepCopyCatCollection(Vw.Components, "DrawingComponents")
    Set GetComp2DList = Lst
End Function

'コンポーネント2Dの存在するビュー取得  メイン・背景・ロック・非表示除外
Private Function GetExistComp2DView() As Collection
    Set GetExistComp2DView = Nothing
    Dim Vws As DrawingViews
    Set Vws = CATIA.ActiveDocument.Sheets.ActiveSheet.Views
    If Vws.Count < 3 Then Exit Function
    Dim ViewLst As Collection
    Set ViewLst = DeepCopyCatCollection(Vws, "DrawingViews")
    Call ViewLst.Remove(1) 'メイン削除
    Call ViewLst.Remove(1) '背景削除
    Dim Vw As DrawingView
    Dim Lst As Collection: Set Lst = New Collection
    For Each Vw In ViewLst
        If Vw.LockStatus = False And IsShow(Vw) And _
                                Vw.Components.Count > 0 Then
            Lst.Add Vw
        End If
    Set GetExistComp2DView = Lst
End Function

Private Function IsShow(ByVal Oj As AnyObject) As Boolean
    Dim Sel As Selection: Set Sel = CATIA.ActiveDocument.Selection
    Dim Vis As VisPropertySet:
    Set Vis = Sel.VisProperties
    Dim ShowState As CatVisPropertyShow
    CATIA.HSOSynchronized = False
        Sel.Add Oj
        Call Vis.GetShow(ShowState)
    CATIA.HSOSynchronized = True
    IsShow = IIf(ShowState = catVisPropertyDefined, True, False)
End Function

Private Function DeepCopyCatCollection(ByVal CatCol As AnyObject, _
                                        ByVal OjType$) As Collection
    Set DeepCopyCatCollection = Nothing
    Dim Col As Variant
    Select Case OjType '面倒・・・
        Case "DrawingViews"
            Dim Vws As DrawingViews: Set Vws = CatCol
            Set Col = Vws
        Case "DrawingComponents"
            Dim Cmps As DrawingComponents: Set Cmps = CatCol
            Set Col = Cmps
        Case Else
            Set Col = CatCol
    End Select
    Dim Lst As Collection: Set Lst = New Collection
    Dim v
    For Each v In Col
        Lst.Add v
    Set DeepCopyCatCollection = Lst
End Function