Pasek aktywacji makr blokujący wszystkie części z ASM

Macro
1

Witam

bycie naprawdę kiepskim w makro; Wysyłam Marco z @jeromeP, który należy wykonać, aby obniżyć pręt odzyskiwania z zespołu do wszystkich części.

Chciałbym wiedzieć, czy można osiągnąć to samo, ale za pomocą listwy blokującej, która zablokuje funkcje PRT, a tym samym zaoszczędzi czas rekonstrukcji podczas otwierania ASM

 

Z góry dziękuję :-)

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

Właściwie musisz go zamontować za pomocą swMoveFreezeBarToTop:

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 polubienie
3

Witaj ac cobra 427 jak się masz?

Zajrzyj tutaj, powinieneś znaleźć to, czego szukasz.

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

Niech Moc będzie z wami.

 

1 polubienie
4

Witaj ac kobra 427,

A ponieważ można to zrobić na kilka sposobów, oto mój wkład:

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

Pozdrowienia

1 polubienie
5

Dziękuję wszystkim za wkład, wybieram OBI WAN, ponieważ jest tam również makro do podnoszenia poprzeczki bloków.

Jeszcze raz dziękuję :-) 

Wszystko idzie dobrze, a Ty, pomimo ograniczenia, które zaczyna Ci ciążyć...  

1 polubienie