Hallo
Ik heb gezocht en ik kon geen kleine macro vinden die het huidige tabblad van een solidworks-tekening in dxf-formaat (voor lasersnijden) exporteert met de exacte naam van het huidige plantabblad als bestandsnaam
Heeft iemand de walkthrough?
Merk op dat ik slecht ben in VBA-programmeren
Bij voorbaat dank
Hallo
Kijk naar deze macro, probeer het en vertel me of je het goed vindt
Sub hoofd()
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim montab als variant
Dim montab2 Als Variant
Dim montab3 Als Variant
Dim inintern als snaar
Dim naam als string
Dim pad als snaar
Dim naam als tekenreeks
Dim FilePath als tekenreeks
Dim PathSize zo lang
Dim PathNoExtension als tekenreeks
Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
FilePath = swModel.GetPathName
Padgrootte = Strings.Len(FilePath)
PathNoExtension = Strings.Left(FilePath, PathSize - 7)
montab = Splitsen(swModel.GetPathName, "\", -1)
interm = montab(UBound(montab))
naam = Midden (interm, 1, Len(interm) - 7)
montab2 = Splitsen(naam, ".", 2)
Naam = montab2(0)
'montab3 = Splits(naam, "$", 2)
'Naam = Montab3(1)
path = PathNoExtension & ".dxf" 'formaat waarin u wilt opslaan
'pathMEP = swModel.GetPathName
'FullFileName = Mid(MEPPATH, 1, Len(MEPPATH) - 7)
'Elements = Split(FullFileName, "\", -1)
'FullFileName = Elementen(0)
'MessAlert = MsgBox("Accepteert u dit bestand?" + FullFileName, vbYesNo)
'Als MessAlert = vbNo dan afsluit Sub
name = naam & " - Blad 1"
Deel instellen = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Part.SaveAs2 pad, 0, Waar, Onwaar
Deel.Opslaan2 Onwaar
Set Deel = Niets
swApp.CloseDoc swModel.GetTitle
'Set swModel = Niets: Set swApp = Niets
Einde Sub
Hallo gwygwy
Bedankt, het werkt!
Maar het slaat op met de bestandsnaam en niet met de naam van het huidige tabblad
Is het mogelijk om te wijzigen?
Bij voorbaat dank
Hallo
Ik ben geen specialist, dus ik kon de naam van het document en de naam van het blad plaatsen, maar niet beter.
Sub hoofd()
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim montab als variant
Dim montab2 Als Variant
Dim montab3 Als Variant
Dim inintern als snaar
Dim naam als string
Dim Name2 als string
Dim pad als snaar
Dim naam als tekenreeks
Dim FilePath als tekenreeks
Dim PathSize zo lang
Dim PathSizeTitle zo lang
Dim PathNoExtension als tekenreeks
Dim PathNoExtension2 als tekenreeks
Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
FilePath = swModel.GetPathName
Padgrootte = Strings.Len(FilePath)
PathNoExtension = Strings.Left(FilePath, PathSize - 7)
name2 = swModel.GetTitle
montab = Splitsen(swModel.GetPathName, "\", -1)
interm = montab(UBound(montab))
naam = Midden (interm, 1, Len(interm) - 7)
montab2 = Splitsen(naam, ".", 2)
Naam = montab2(0)
PathSizeTitle = Tekenreeksen.Len(naam)
PathNoExtension2 = Tekenreeksen.Links(PathNoExtension, PadGrootte - PathSizeTitle - 7)
'montab3 = Splits(naam, "$", 2)
'Naam = Montab3(1)
path = PathNoExtension2 & name2 & ".dxf" 'formaat in welk formaat je wilt opslaan
'pathMEP = swModel.GetPathName
'FullFileName = Mid(MEPPATH, 1, Len(MEPPATH) - 7)
'Elements = Split(FullFileName, "\", -1)
'FullFileName = Elementen(0)
'MessAlert = MsgBox("Accepteert u dit bestand?" + FullFileName, vbYesNo)
'Als MessAlert = vbNo dan afsluit Sub
'naam = naam & " - Blad 1"
Deel instellen = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Part.SaveAs2 pad, 0, Waar, Onwaar
Deel.Opslaan2 Onwaar
Set Deel = Niets
'swApp.CloseDoc swModel.GetTitle
Stel swModel = Niets in: Stel swApp in = Niets
Einde Sub
@gwygwy de voorgestelde macro is verre van schoon in termen van code, dubbele, nutteloze code... En bovendien zie ik niet in hoe je aan de naam van het blad komt. De enige bladnaam is getypt in de mano "Leaf1"
Om het bestand met de naam van het tabblad te exporteren, zie dit onderwerp waarop ik heb geantwoord zonder te weten of het antwoord bij je paste of niet.
https://www.lynkoa.com/forum/solidworks/export-diff%C3%A9renci%C3%A9-en-pdf-et-dxf-des-onglets-de-mise-en-plan-par-une-macro
Indien nodig kan het worden aangepast zonder de voorwaarde als Cutout aanwezig in de tabbladnaam te zetten en zonder deze uit de bestandsnaam te verwijderen, indien nodig.
Maar over het algemeen vermijden we het openen van 2 zeer nabije of identieke onderwerpen.
Hoi @sbadenis
Ja, de code is niet schoon, ik ben geen professional. Ik heb een bestaande macro gewijzigd waar nog steeds wat code is die geen enkel doel dient, maar ik bewaar deze voor het geval ik deze in een andere macro nodig heb.
En nee, hij is niet geraakt zoals je zegt, er is een ' voor de lijn. Dus deze regel is nutteloos.
Ik herstel met get.title, dat is alles wat ik heb gevonden. Maar als je een macro hebt die voor hem werkt, doe het dan je lijkt goed te coderen.
@gwygwy geen zorgen, het was alleen voor jou! En inderdaad, ik had de get.title niet gezien, maar op zich krijg je de naam van het document + de naam van het actieve blad
Als u de naam van elk blad wilt ophalen en elk blad wilt exporteren met de naam van het blad als exportnaam, moet u een lus op de bladen maken zoals op de macro in de koppeling. Als je geïnteresseerd bent, nodig ik je uit om te kijken, er is niets te ingewikkeld, 2 jaar geleden had ik geen kennis van vba en het is met vallen en opstaan dat ik erin ben gerold.
Voor de macro heb ik er een gemaakt in het andere onderwerp, maar geen antwoord @Fennec_Flegmatique lijkt afwezig te zijn voor de abonnees!
Vrienden, ik ben niet bij de abscente abonnees
Bedankt voor je bijdragen en voor de tijd die je besteedt aan het reageren op mij
Ik boek vooruitgang in het begrijpen van de codes (ik ben een Boeotiaan), maar het is een beetje lang
Ik heb mijn onderwerp nog niet opgelost
Ik laat het je weten als ik het vind of als ik het waard ben!