Makro-Aktivierungsleiste, die alle Teile eines ASM blockiert

Macro
1

Hallo

wirklich schlecht in der Makroökonomie zu sein; Ich poste einen Marco von @jeromeP gemacht werden muss, um die Bergungsstange von einer Baugruppe auf alle Teile abzusenken.

Ich hätte gerne gewusst, ob es möglich ist, das Gleiche zu erreichen, aber mit der Blockierleiste, die die Funktionen der PRTs sperrt und somit Rekonstruktionszeit beim Öffnen des ASM spart

 

Vielen Dank im Voraus :-)

Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
    Dim swModel As SldWorks.ModelDoc2
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
    TraverseComponent swRootComp
End Sub

Sub TraverseComponent(swComp As SldWorks.Component2)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim i As Long
    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp
    Next i
    RollBack swComp
End Sub

Sub RollBack(swComp As SldWorks.Component2)
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swComp.GetModelDoc2
    swApp.ActivateDoc3 swComp.Name2, False, swRebuildOnActivation_e.swRebuildActiveDoc, Empty
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then Exit Sub
    swModel.FeatureManager.EditRollback swMoveRollbackBarTo_e.swMoveRollbackBarToEnd, Empty
    swModel.EditRebuild3
    swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, Empty, Empty
    swApp.CloseDoc swModel.GetPathName
End Sub

 

2

Sie müssen es tatsächlich mit swMoveFreezeBarToTop mounten:

Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
    Dim swModel As SldWorks.ModelDoc2
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
    TraverseComponent swRootComp
End Sub

Sub TraverseComponent(swComp As SldWorks.Component2)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim i As Long
    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        TraverseComponent swChildComp
    Next i
    RollBack swComp
End Sub

Sub RollBack(swComp As SldWorks.Component2)
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swComp.GetModelDoc2
    swApp.ActivateDoc3 swComp.Name2, False, swRebuildOnActivation_e.swRebuildActiveDoc, Empty
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then Exit Sub
    swModel.FeatureManager.EditFreeze2 swMoveFreezeBarTo_e.swMoveFreezeBarToTop, Empty, True, True
    swModel.EditRebuild3
    swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, Empty, Empty
    swApp.CloseDoc swModel.GetPathName
End Sub

 

1 „Gefällt mir“
3

Hallo ac cobra 427, wie geht es dir??

Schauen Sie hier, Sie sollten finden, was Sie suchen.

https://www.lynkoa.com/forum/solidworks/actionner-la-barre-de-blocage-macro-sur-toutes-pi%C3%A8ces-dun-assemblage?page=0#answer-1083726

Möge die Macht mit euch sein.

 

1 „Gefällt mir“
4

Hallo ac cobra 427,

Und da es mehrere Möglichkeiten gibt, dies zu tun, hier mein Beitrag:

Option Explicit

Dim swApp As Object
Dim longstatus As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2

Sub main()
    Set swApp = Application.SldWorks
    Set Assembly = swApp.ActiveDoc
    Set myAssy = Assembly

    myCmps = myAssy.GetComponents(False)
    For i = 0 To UBound(myCmps)
        Set myCmp = myCmps(i)
        If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
            bRet = myCmp.Select2(False, 0)
            Set swModel = myCmp.GetModelDoc2
            If swModel.GetType = swDocumentTypes_e.swDocPART Then
                swApp.ActivateDoc2 swModel.GetPathName, True, longstatus
                bRet = swModel.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToEnd, "", False)
                'bRet = swModel.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToTop, "", False)
                bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
                swApp.CloseDoc (swModel.GetTitle())
            End If
            myAssy.EditAssembly
        End If
    Next i
    
    Assembly.ForceRebuild3 False
    Assembly.SaveAs (Assembly.GetPathName)
    
    MsgBox "Traitement terminé.", vbExclamation

End Sub

Herzliche Grüße

1 „Gefällt mir“
5

Vielen Dank an alle für Ihre Beiträge, ich habe OBI WAN gewählt, weil es auch das Makro gibt , um die Blockleiste anzuheben.

Nochmals vielen Dank :-) 

Es läuft gut und du, trotz der Enge, die dich zu belasten beginnt...  

1 „Gefällt mir“