Creatie maccro STEp PDF STEP

benjamin.guyetand · 20 september 2023 om 11:21

Hallo team,

Ik besloot een maccro te gaan maken om tijd te besparen op mijn werk.

Als beginner las ik eerst veel onderwerpen op dit forum, maar ik vond niet per se mijn antwoorden.

Laat het me uitleggen: ik heb een maccro gemaakt met de functie "Opslaan".

Het doel van deze maccro zou in orde zijn:

Vanuit een kamer. SLDPRT
Sla het op in . STAP
Open je tekening
Opslaan als . DxF
Opslaan als PDF
Tekening sluiten
Sluit de kamer

De code die daaruit voortkomt is als volgt:

’ ******************************************************************************
' C:\Users\bguyetand\AppData\Local\Temp\swx4952\Macro1.swb - macro opgenomen op 20/09/23 door BGuyetand
’ ******************************************************************************
Dim swApp als object

Deel dimmen als object
Dim boolstatus als Booleaanse
Dim longstatus As Long, longwarnings As Long

Sub hoofd()

Stel swApp = Toepassing.SldWorks in

Deel instellen = swApp.ActiveDoc

' Opslaan als
longstatus = Deel.SaveAs3("C:\Gebruikers\bguyetand\Desktop\Part1.STEP", 0, 2)

' Open
Set Part = swApp.OpenDoc6("C:\Users\bguyetand\Desktop\Part1.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing Als DrawingDoc
Set swDrawing = Deel
Deel instellen = swApp.ActiveDoc
myModelView dimmen als object
Stel myModelView = Deel.ActiveView in
myModelView.FrameLeft = 0
myModelView.FrameTop = 22
Stel myModelView = Deel.ActiveView in
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "Part1 - Sheet1", False, longstatus
Deel instellen = swApp.ActiveDoc
Stel myModelView = Deel.ActiveView in
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Opslaan als
longstatus = Deel.SaveAs3("C:\Gebruikers\bguyetand\Desktop\Pièce1.pdf", 0, 2)
Deel.BladVorige

' Hertekenen
Deel.GraphicsRedraw2

' Inzoomen op gebied
Deel.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1

' Opslaan als
longstatus = Deel.Opslaan3("C:\Gebruikers\bguyetand\Desktop\Part1.DXF", 0, 2)

' Document sluiten
Set swDrawing = Niets
Set Deel = Niets
swApp.CloseDoc "Deel 1 - Blad1"
Deel instellen = swApp.ActiveDoc
Stel myModelView = Deel.ActiveView in
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Stel myModelView = Deel.ActiveView in
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "Part1.SLDPRT", False, longstatus
Deel instellen = swApp.ActiveDoc
Stel myModelView = Deel.ActiveView in
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Document sluiten
Set swPart = Niets
Set Deel = Niets
swApp.CloseDoc "Deel 1.SLDPRT"
Einde Sub

Mijn probleem is dat momenteel, wanneer ik deze maccro start, het mijn testkamer opent die ik had gemaakt (een eenvoudige kubus) om de stappen uit te vouwen.
Bovendien neemt het alles op het bureaublad op.

Is het mogelijk om mij in mijn maccro uit te leggen:

Hoe kan ik mijn "test" deel vervangen door het "actieve" deel op mijn scherm?
Hoe sla ik de bestanden op in de open kamermap?

Ik hoop dat ik duidelijk genoeg ben geweest in mijn uitleg

Bij voorbaat dank voor de tijd die u mij geeft!!

sbadenis · 20 september 2023 om 11:28

Hallo
Bekijk deze code om een onderdeel of assemblage als stap op te slaan.
Het is goed becommentarieerd, het zou je veel moeten helpen:

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
      
    Sub main()
      
'1-) on vérifie qu'un document est ouvert
  Debug.Print "1-)On vérifie qu'un document est ouvert"
  Set swApp = CreateObject("SldWorks.Application")
  Set swModel = swApp.ActiveDoc        ' On récupère le document d'ouvert
  If swModel Is Nothing Then           ' On vérifie si un document est ouvert
    MsgBox "Pas de document d'ouvert." + Chr$(13) + _
           "Une pièce ou assemblage SolidWorks doit être ouverte, " + Chr$(13) + _
           "avant de relancer cette macro."
  Else
    FileTyp = swModel.GetType
    If ((FileTyp = swDocPART) Or (FileTyp = swDocASSEMBLY)) Then 'Si le document est une pièce ou un assemblage

'2-)On vérifie si une config sym existe
        'On vérifie si la configuration active est une configuration dérivée (Si Symétrique retour config defaut)
        Set swCompModelConfig = swModel.GetActiveConfiguration
        Dim vConfigName As Variant
        Dim swParentConfig As SldWorks.Configuration
        Dim swConfMgr As SldWorks.ConfigurationManager
        Dim partTitle As String
        partTitle = swModel.GetTitle
        Debug.Print "partTitle:" & partTitle
                        
        If swCompModelConfig.IsDerived Then
        Debug.Print "Configuration dérivée:" & swCompModelConfig.IsDerived
        Debug.Print "Pause"
                Dim swConfig As SldWorks.Configuration
                    Set swConfig = swModel.GetConfigurationByName(vConfigName)
                    ' Process parent
                    Set swParentConfig = swCompModelConfig.GetParent
                    If Not swParentConfig Is Nothing Then
                        Debug.Print "      Parent = " & swParentConfig.Name
                        swModel.ShowConfiguration2 (swParentConfig.Name)
                    End If
        End If
        
'2-)On enregistre en step
        Debug.Print "2-)On enregistre en step"
        swModel.Extension.SaveAs Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "STEP", 0, 0, Nothing, 0, 0
        MsgBox (Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "step sauvegardé")
                  
        
    




'4-)On enregistre en step la config sym si existante
         'Pour toutes les configurations du modèle 3D
            configNames = swModel.GetConfigurationNames
            For Each ConfigName In configNames
            Debug.Print "4-Nom de config:" & ConfigName
            Set swConfig = swModel.GetConfigurationByName(ConfigName)
            Set swCustPropMgr = swConfig.CustomPropertyManager
                If ConfigName Like "*Sym*" Then
                        If ConfigName Like "*Sym*Sym*" Then
                            MsgBox "Attention Symétrie de Symétrie merci de corriger votre assemblage et supprimer cette configuration: " & ConfigName
                        End If
                        'Mis en commentaire jusqu'au passage en pièce SYM sur 2 MEP
                        'If swModel.GetCustomInfoValue(ConfigName, "Symetrie") <> "" Then
                            'On active la config Sym
                            swModel.ShowConfiguration2 (ConfigName)
                            Debug.Print "4)On enregistre en step le Sym"
                            Debug.Print Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-SYM.STEP"
                            swModel.Extension.SaveAs Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-SYM.STEP", 0, 0, Nothing, 0, 0
                            MsgBox (Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-SYM" & ".step sauvegardé")
                        'End If
                    End If
                Next
        
        
    Else
      MsgBox "Pas de pièce ou assemblage d'ouvert." + Chr$(13) + _
           "Une pièce ou assemblage SolidWorks doit être ouvert, " + Chr$(13) + _
           "avant de relancer cette macro."
    End If          ' Fin vérification si un plan est ouvert
    End
  End If            ' Fin vérification si un document est ouvert

End Sub

benjamin.guyetand · 20 september 2023 om 11:47

Dank u voor uw antwoord,

Ik kijk er zo snel mogelijk naar toe.

Maclane · 20 september 2023 om 12:23

Hallo;

Om het antwoord van @sbadenis compleet te maken:

De belangrijke informatie van zijn voorstel is:

=>… Stel swModel = swApp.ActiveDoc in (om te werken aan het actieve Solidworks-document)
=> … swModel.GetPathName (om het (volledige) pad van het in Solidworks geopende document op te halen)

om voorzichtig macro's in handen te krijgen, raad ik je aan (naast de Solidworks API-hulp):

en

(Zeer interessante video's op CadSharp)

en meer in het algemeen (voornamelijk Excel maar VBA is VBA):

En vergeet altijd niet om commentaar te geven op je creaties (want over tien jaar begrijp je niet meer per se wat je op dat moment hebt gedaan...)

Vriendelijke groeten.

Centor · 20 september 2023 om 12:39

Hallo

als het je misschien interesseert, hier heb ik de macro om in PDF te doen, zodat je een code voor de PDF hebt
Voor afdrukken via PDF.swp (23 KB)

En hier voor de dxf-uitvoer in schaal 1:1
Enregistre_DXF_echel_1-1.swp (34 kB)

Het kan nuttig voor u zijn

benjamin.guyetand · 20 september 2023 om 13:11

Dank u allen voor uw antwoorden,

Ik denk nu al dat ik nog wel wat meer uit mijn puinhoop kan komen.

Goed hoor

coin37coin · 21 september 2023 om 06:28

En niet alleen in 10 jaar... Soms al binnen 15 dagen!

Anders denk ik dat er al veel links voor de hulp zijn geweest, maar aarzel niet om terug te komen om je laatste macro met ons te delen

benjamin.guyetand · 21 september 2023 om 06:46

Hallo

Om heel eerlijk te zijn, ik heb er gisteren naar gekeken, maar het werkt nog steeds niet

Ik heb zelfs de indruk dat de codes die uit de "Opslaan"-modus van de maccros komen, niet dezelfde zijn als degene die je met de hand lijkt te typen.
Dus ik krab een beetje op mijn hoofd voordat ik hier kom om hulp te roepen

sbadenis · 21 september 2023 om 07:45

De code die door de recorder wordt gegenereerd, zit vol fouten en wordt alleen gebruikt om een paar mogelijke functies te identificeren.
Alles wat met MyModelView te maken heeft, is bijvoorbeeld volkomen nutteloos.
Hier is de schone code en lijkt allemaal functioneler, met de opmerkingen die goed gaan.
Om deel 1 te vervangen door het actieve deel, haalt u de naam van het actieve deel op met: swModel.GetPathName
Vervolgens verwijderen we via VBA manip de extensie voor de verschillende opnames.
De code:

'Déclarations
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()
Set swApp = Application.SldWorks


'1-) on vérifie qu'un document est ouvert
  Set swModel = swApp.ActiveDoc        ' On récupère le document d'ouvert
  If swModel Is Nothing Then           ' On vérifie si un document est ouvert
    MsgBox "Pas de document d'ouvert." + Chr$(13) + _
           "Une pièce ou assemblage SolidWorks doit être ouverte, " + Chr$(13) + "avant de relancer cette macro."
  Else
    FileTyp = swModel.GetType
    If ((FileTyp = swDocPART) Or (FileTyp = swDocASSEMBLY)) Then 'Si le document est une pièce ou un assemblage


        
'2-)On enregistre en step
        swModel.Extension.SaveAs Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "STEP", 0, 0, Nothing, 0, 0 'on sauvegarde l'assemblage ou pièce active en step en récupérant le nom sans l'extension
        MsgBox (Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "step sauvegardé") 'On affiche dans une box le chemin du step. Au besoin ajouter le symbol' au début de la ligne pour la passer en commentaire
        
'3-)On ouvre la MEP du modèle actif
        Set swDraw = swApp.OpenDoc6(Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "slddrw", 3, 0, "", longstatus, longwarnings) 'Ouverture de la MEP
        longstatus = swDraw.SaveAs3(Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "pdf", 0, 2) 'On l'enregistre en pdf avec le même nom .pdf
        MsgBox (Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "pdf sauvegardé") 'On affiche dans une box le chemin du pdf. Au besoin ajouter le symbol' au début de la ligne pour la passer en commentaire

'4-)On enregistre la MEP en dxf
        longstatus = swDraw.SaveAs3(Left(swDraw.GetPathName, InStrRev(swModel.GetPathName, ".")) & "dxf", 0, 2) 'On l'enregistre en pdf avec le même nom .dxf
        MsgBox (Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "dxf sauvegardé") 'On affiche dans une box le chemin du pdf. Au besoin ajouter le symbol' au début de la ligne pour la passer en commentaire

'5-)On ferme les documents
        swApp.CloseDoc Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".")) & "slddrw" 'On ferme la MEP
        swApp.CloseDoc swModel.GetPathName 'On ferme le model actif au besoin ajouter ' pour mettre la ligne en commentaire et ne pas fermer le modèle actif

        Set swDrawing = Nothing 'On vide la variable
        Set swModel = Nothing 'On vide la variable
        
    Else
      MsgBox "Pas de pièce ou assemblage d'ouvert." + Chr$(13) + _
           "Une pièce ou assemblage SolidWorks doit être ouvert, " + Chr$(13) + _
           "avant de relancer cette macro."
    End If          ' Fin vérification si un plan est ouvert
    End
  End If            ' Fin vérification si un document est ouvert

End Sub

benjamin.guyetand · 21 september 2023 om 08:06

Sbadenis,

Hartelijk dank voor uw hulp,

Ik zou nooit in zo'n korte tijd alleen de oplossing hebben gevonden,
De opmerkingen zijn geweldig en zullen me in staat stellen me te begeleiden bij mijn volgende maccros.

Ik zal mijn creaties die werken posten als ik er een paar heb

Nogmaals bedankt aan het team voor jullie tijd!

sbadenis · 21 september 2023 om 08:31

Als dat is wat je wilde, vergeet dan niet het onderwerp te sluiten door het antwoord te selecteren dat je probleem heeft opgelost. Bedankt

benjamin.guyetand · 21 september 2023 om 08:49

Het is klaar