Macro-opname als pdf actief blad

Hoi allemaal

Ik heb momenteel een macro waarmee ik mijn .slddrw-document in pdf kan opslaan onder dezelfde map en dezelfde naam.

Tot nu toe gaat het goed, het probleem is dat het alle vellen van mijn tekening opslaat en ik wil dat het me alleen het actieve blad opslaat wanneer ik mijn macro start.

Ik weet zeker dat de oplossing eenvoudig is, maar niets te doen Ik kan de juiste code niet vinden, hier is de macro die ik van het forum heb gekregen en die ik gebruik:

'**************************************************************************************************************************
'* Voorbeeld van een macro waarmee u documenten als PDF's kunt opslaan
'* U kunt de extensie wijzigen om het document op te slaan in elk formaat dat door SW wordt ondersteund
'* Gebaseerd op het voorbeeld van Axemble "Saveas_pdf"
'* Bewerken door MCD
'**************************************************************************************************************************
Sub hoofd()
    Dim swApp als SldWorks.SldWorks
    Dim swmodel als SldWorks.ModelDoc2
    Dim stPath als snaar
    Dim lgFile zo lang
    Dim blretval als Booleaanse
    Dim fouten zo lang
    Dim waarschuwingen zo lang
    
    Stel swApp = Toepassing.SldWorks in
    'We krijgen het actieve document
    Stel swmodel = swApp.ActiveDoc in
    
    Zo niet, dan is Swmodel niets
       'Wij controleren of het dossier geregistreerd is
        Als swmodel. GetPathName = "" dan
            MsgBox "Sla uw document op voordat u de macro start", vbInformatie
            Einde
        Anders
            'We krijgen de locatie van het bestand
            stPath = swmodel. GetPathName (GetPathNaam)
            'We krijgen het aantal tekens tot . van de extensie
            lgFile = InStrRev(stPath, ".", -1, vbTextCompare) - 1
            'We herstellen het pad zonder de uitbreiding
            Als lgFile > 0 Dan
                  stPath = Links(stPath, lgFile)
            Einde als
        Einde als
        
        "Indien het document een document is
        Als swmodel. GetType = swDocPART Dan
           Wij creëren de ontwikkelde
            'blretval = swmodel. ExportFlatPatternView(stPath & ". DXF", 1)
            De DXF werd opgericht
            'blretval = swmodel. SaveAs3(stPath & ". DXF", 0, 0)
             MsgBox: "Dit is een Piéce-bestand. Open de tekening om de PDF te maken", vbInformatie
            
            'Als het document een tekening is
        ElseIf swmodel. GetType = swDocDRAWING dan
            De DXF werd opgericht
            'blretval = swmodel. SaveAs3(stPath & "_drw.pdf", 0, 0)
            Maak de PDF
            blretval = swmodel. SaveAs3(stPath & ".pdf", 0, 0)
            
            
        Einde als
    
        'We slaan het bestand op
        blretval = swmodel. Opslaan3(0, 0, 0)
   
    Einde als

Einde Sub

 

Hallo

Je gebruikt de SaveAs3 methode, door naar de helppagina te gaan kun je zien dat deze methode verouderd is:

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IModelDoc2~SaveAs3.html

En dat u in plaats daarvan SaveAs moet gebruiken:

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IModelDocExtension~SaveAs.html

Bij deze laatste methode kun je aangeven welk blad je wilt opslaan, zie dit voorbeeld:

http://help.solidworks.com/2012/English/api/sldworksapi/Save_File_as_PDF_Example_VB.htm

Voor meer informatie over het kiezen van bladen:

http://help.solidworks.com/2012/English/api/sldworksapi/SolidWorks.Interop.sldworks~SolidWorks.Interop.sldworks.IExportPdfData.html

 

4 likes

Het begint ingewikkeld voor mij te worden, kun je proberen mijn macro  STP aan te passen?

Je hebt alle informatie om het te doen.

Anders, omdat je myCADtools hebt, kun je een van de tools gebruiken om het te doen, het kan gemakkelijker voor je zijn: Integratie of Batch Converter kan het doen.

3 likes

Ik ben het helemaal met .PL eens, al het werk is pre-;). Als VBA je nu complex lijkt en je wilt er niet mee rotzooien (wat volkomen begrijpelijk is, er is geen waardeoordeel!), dan is kleine kant-en-klare software erg goed.

 

Ik zou de opmerkingen van @PL echter een beetje willen afzwakken. Ik ben er zeker van dat als je dingen probeert, om uitleg vraagt over obscure punten, enz., hij of een andere persoon hier je zal kunnen begeleiden. Maar dingen geven die al kant-en-klaar zijn... Is dat niet echt de filosofie van het forum:)

1 like

Het zij verre van mij om hooghartig te zijn, maar ik heb SolidWorks niet bij de hand, dus ik kan blindelings een macro testen als ik tijd heb, wat vandaag niet het geval is!

Goedenavond

Probeer deze eens:

 

Dim swApp als SldWorks.SldWorks
Dim swModel als ModelDoc2
Dim lErrors zo lang
Dim lWaarschuwingen zo lang mogelijk

Sub hoofd()

Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " rev." & swModel.GetCustomInfoValue("", "Revisie") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

Einde Sub

Functie GetFilename(strPath As String) Als String
Dim strTemp als snaar
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
Functie beëindigen

Bedankt voor je antwoorden, sorry Manu67, er gebeurt niets bij het starten van de macro.

Als het niet werkt, komt dat omdat je in 2015 bent... Het werkte voor mij in 2014, maar niet in 2015 en werkt weer in 2016. Ik kan het niet uitleggen. Probeer over te schakelen naar 2016 SP2 of wacht wat tijd op SP3 als je dat kunt.