Bonjour,
étant vraiment nul en macro; je poste une marco de @jeromeP à réalisé pour descendre la barre de reprise depuis un assemblage vers toutes les pièces.
J'aurais aimé savoir s'il est possible de réaliser la même chose mais avec la barre de blocage qui verrouillera les fonctions des PRT et ainsi fera gagner du temps de reconstruction lors de l'ouverture de l'ASM
merci d'avance :-)
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
Il faut en fait la monter avec 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 « J'aime »
Bonjour ac cobra 427 comment vas??
regards ici tu devrait trouver ton bonheur.
https://www.lynkoa.com/forum/solidworks/actionner-la-barre-de-blocage-macro-sur-toutes-pi%C3%A8ces-dun-assemblage?page=0#answer-1083726
que la force soit avec toi.
1 « J'aime »
Bonjour ac cobra 427,
Et comme il y a plusieurs façons de faire, voici ma contribution :
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
Cordialement,
1 « J'aime »
Merci à tous pour vos contributions, je sélectionne OBI WAN car il y a aussi la macro pour remonter la barre de blocage.
Encore merci :-)
ça va bien et toi, malgré le confinement qui commence à peser....
1 « J'aime »