Bedien de macroblokbalk op alle onderdelen van een assemblage

Macro
1

Hoi allemaal

Weet iemand een macro om de freeze bar te bedienen op alle onderdelen van een assemblage (zie alle onderdelen van verschillende subassemblages indien mogelijk)?

Ik kijk, maar kan het niet vinden...

Bedankt!

2

Ik vond deze macro die niet altijd werkt, maar had geen tijd om dieper te graven:

'       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

De originele link:

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

3

Hallo

Of de tool "Integratie" in myCADtools

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

Cdlt

Alan

4

Bedankt voor je feedback.

@sbadenis, ik had deze macro ook gevonden, maar hij werkt niet (behalve individueel op het onderdeel rechtstreeks, wat niet erg handig is...)

@acombier, helaas, ik heb geen mycadtools. We zitten nog steeds in SW2016 SP05 zonder ondersteuning.... (Geen commentaar).

5

Ik heb het net opnieuw getest op een assemblage en het lijkt te werken.

Start je de freezeALL sub?

Als u de bevriezing start, werkt deze alleen op het huidige deel.

6

Kortom, je moet de macro (?) uitvoeren:

' MODULE: FREEZE PARTS ' PROGRAMMEUR: DMITRY ZAMOSHNIKOV ' DATUM: 13/11/2013 ' DOEL: ' DOORLOOP EEN ASSEMBLAGE EN BEVRIES ELK ONDERDEEL IN DE ASSEMBLAGE. ' FUNCTIE: FREEZE_ALL ' IN: GEEN ' UIT: ALLE ONDERDELEN ==BEVROREN? ' 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 (ONDERDELEN IN ASSEMBLY NOT FROZEN > 0 ) ' OPEN DEEL ' BEVRIES ONDERDEEL ' DEEL OPSLAAN ' DEEL SLUITEN ' WEND Public Sub FREEZE_ALL() Stel swapp in = Application.SldWorks Stel swAllDocs in = swapp. EnumDocuments2 Stel FirstDoc in = swapp. ActiveDoc DocCount = 0 swAllDocs.Reset swAllDocs.Next 1, swdoc, NumDocsReturned ' Deze lus doorloopt alle documenten binnen een assembly, inclusief subassemblages. Terwijl NumDocsReturned <> 0 bDocWasVisible = swdoc. Het zichtbare script 'Gebruik verborgen onderdelen' is gecrasht als er een poging wordt gedaan om een assemblage te bevriezen. ' Controleer het bestand om er zeker van te zijn dat het een "SLDPRT"-bestand is. Als (UCase(Right(swdoc. GetPathName, 6)) = UCase("sldprt")) Wissel dan om. ActiveerDoc2 swdoc. GetPathName, True, longstatus 'open en activeer het deel boolstatus = swdoc. FeatureManager.EditFreeze(swMoveFreezeBarTo_e.swMoveFreezeBarToEnd, "", True) ' verplaats de bevriezingsbalk naar het einde swdoc. SaveAs (swdoc. GetPathName) ' sla de wijziging op. CloseDoc (swdoc. GetTitle()) ' sluit het onderdeel End If swAllDocs.Next 1, swdoc, NumDocsReturned ' Ga naar het volgende deel DocCount = DocCount + 1 ' Houd een telling bij van alle onderdelen binnen de assembly, inclusief subassemblages. Wend End Sub

7

Hallo

Naar mijn bescheiden mening moet je helemaal niets starten zonder eerst de werking van deze macro te lezen en te analyseren, die niet erg goed werkt, maar ronduit te goed ...

De functie "EnumDocuments2" is een functie op hoog niveau in de Sldworks-naamruimte, het stelt u in staat om alle documenten te kennen die in Solidworks zijn geopend en niet alleen in de assemblage die u denkt te verwerken...

Vriendelijke groeten

1 like
8

Hallo

Dat is een geschenk.

Moge de kracht met je zijn.

 


freeze.zip
3 likes
9

@OBI WAN, dit lijkt me veel coherenter ...

 

1 like
10

Aan de top OBIWAN! Dank u allen voor uw antwoorden.

1 like