Actionner la barre de blocage (Macro) sur toutes pièces d'un assemblage

Macro
1

Bonjour à tous,

Quelqu'un connaît-il l'existence d'une macro pour actionner la barre de blocage (freeze bar) sur toutes les pièces d'un assemblage (voir toutes les pièces de différents sous-assemblages si possible) ?

Je cherche mais ne trouve pas...

Merci !

2

J'ai trouvé cette macro qui fonctionne pas toujours, mais pas eu le temps de creuser plus:

'       MODULE:         FREEZE PARTS

'       PROGRAMMER:     DMITRY ZAMOSHNIKOV

'       DATE:           11/13/2013

'       PURPOSE:

'           GO THROUGH AN ASSEMBLY AND FREEZE EVERY PART IN THE ASSEMBLY.

'       FUNCTION: FREEZE_ALL

'           IN: NONE

'           OUT: ALL PARTS==FROZEN?

'

 

 

Dim swdoc As SldWorks.ModelDoc2

Dim swAllDocs As EnumDocuments2

Dim FirstDoc As SldWorks.ModelDoc2

Dim boolstatus As Boolean

Dim NumDocsReturned As Long

Dim DocCount As Long

Dim swapp As SldWorks.SldWorks

Dim longstatus As Long

Dim part As Object

 

 

'   FREEZE_ALL

'       WHILE (PARTS IN ASSEMBLY NOT FROZEN > 0 )

'           OPEN PART

'           FREEZE PART

'           SAVE PART

'           CLOSE PART

'       WEND

Public Sub FREEZE_ALL()

    Set swapp = Application.SldWorks

    Set swAllDocs = swapp.EnumDocuments2

    Set FirstDoc = swapp.ActiveDoc

 

    DocCount = 0

    swAllDocs.Reset

    swAllDocs.Next 1, swdoc, NumDocsReturned

 

 

    ' This loop will go through all of the documents within an assembly, including sub-assemblies.

    While NumDocsReturned <> 0

            bDocWasVisible = swdoc.Visible ' Use Hidden Parts

 

            ' script crashed if an attempt to freeze an assembly is made.

            ' check the file to make sure it's a "sldprt" file.

            If (UCase(Right(swdoc.GetPathName, 6)) = UCase("sldprt")) Then

                swapp.ActivateDoc2 swdoc.GetPathName, True, longstatus 'open and activate the part

                boolstatus = swdoc.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToEnd, "", True)    ' move the freeze bar to the end

                swdoc.SaveAs (swdoc.GetPathName)    ' save the change

                swapp.CloseDoc (swdoc.GetTitle())   ' close the part

            End If

 

            swAllDocs.Next 1, swdoc, NumDocsReturned   ' Go to the next part

            DocCount = DocCount + 1    ' Keep a count of all parts within the assembly, including sub-assemblies.

    Wend

 

 

End Sub

 

 

Sub FREEZE_ONE()

 

    Set swapp = Application.SldWorks

 

    Set part = swapp.ActiveDoc

    boolstatus = part.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToEnd, "", True)

 

    part.SaveAs (part.GetPathName)

    'swapp.CloseDoc part.GetTitle()

 

 

End Sub

Le lien d'origine:

https://forum.solidworks.com/thread/74956

3

Bonjour,

Ou alors, l'outil "Integration" dans myCADtools

https://help.visiativ.com/mycadtools/2021/fr/Integration114.html 

Cdlt

Alain

4

Merc pour vos retours.

@sbadenis, j'avais trouvé cette macro également, mais ne fonctionne pas (sauf en individuel sur la pièce directement, ce qui ne sert pas à grand chose...)

@acombier , malheureusement, je n'ai pas mycadtools . Nous sommes toujours en SW2016 SP05 sans support.... (No comment).

5

Je viens de la re-tester sur un assemblage et ça m'a l'air de fonctionner.

Tu lance bien le sub freezeALL?

Si tu lance le freeze one effectivement cela marche que sur la pièce en cours.

6

En gros, il faut lancer la macro (?) :

' MODULE: FREEZE PARTS ' PROGRAMMER: DMITRY ZAMOSHNIKOV ' DATE: 11/13/2013 ' PURPOSE: ' GO THROUGH AN ASSEMBLY AND FREEZE EVERY PART IN THE ASSEMBLY. ' FUNCTION: FREEZE_ALL ' IN: NONE ' OUT: ALL PARTS==FROZEN? ' Dim swdoc As SldWorks.ModelDoc2 Dim swAllDocs As EnumDocuments2 Dim FirstDoc As SldWorks.ModelDoc2 Dim boolstatus As Boolean Dim NumDocsReturned As Long Dim DocCount As Long Dim swapp As SldWorks.SldWorks Dim longstatus As Long Dim part As Object ' FREEZE_ALL ' WHILE (PARTS IN ASSEMBLY NOT FROZEN > 0 ) ' OPEN PART ' FREEZE PART ' SAVE PART ' CLOSE PART ' WEND Public Sub FREEZE_ALL() Set swapp = Application.SldWorks Set swAllDocs = swapp.EnumDocuments2 Set FirstDoc = swapp.ActiveDoc DocCount = 0 swAllDocs.Reset swAllDocs.Next 1, swdoc, NumDocsReturned ' This loop will go through all of the documents within an assembly, including sub-assemblies. While NumDocsReturned <> 0 bDocWasVisible = swdoc.Visible ' Use Hidden Parts ' script crashed if an attempt to freeze an assembly is made. ' check the file to make sure it's a "sldprt" file. If (UCase(Right(swdoc.GetPathName, 6)) = UCase("sldprt")) Then swapp.ActivateDoc2 swdoc.GetPathName, True, longstatus 'open and activate the part boolstatus = swdoc.FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToEnd, "", True) ' move the freeze bar to the end swdoc.SaveAs (swdoc.GetPathName) ' save the change swapp.CloseDoc (swdoc.GetTitle()) ' close the part End If swAllDocs.Next 1, swdoc, NumDocsReturned ' Go to the next part DocCount = DocCount + 1 ' Keep a count of all parts within the assembly, including sub-assemblies. Wend End Sub

7

Bonjour,

A mon humble avis, il ne faut rien lancer du tout sans avoir préalablement lu et analysé le fonctionnement de cette macro qui ne fonctionne pas très bien mais carrément trop bien ...

La fonction "EnumDocuments2" est une fonction de haut niveau dans le Namespace Sldworks, celle-ci permet de connaitre tous les documents ouvert dans Solidworks et pas seulement dans l'assemblage que l'on pense traiter ...

Cordialement,

1 « J'aime »
8

Bonjour,

voila c'est cadeau.

que la force soit avec vous.

 


freeze.zip
3 « J'aime »
9

@OBI WAN, voilà qui me parait beaucoup plus cohérent ...

 

1 « J'aime »
10

Au top OBIWAN ! Merci à tous pour vos réponses.

1 « J'aime »