Hoi allemaal
Ik ben op zoek naar een macro om .dxf-exports uit te voeren van alle 3D die in een bestand aanwezig is. Laat het me uitleggen, al mijn 3D-plaatwerkbestanden staan in een klantenmap en ik zou graag willen dat elk onderdeel wordt uitgevouwen wanneer ik de macro uitvoer en het opsla als een .dxf-bestand plaatwerkoptie.
Ik keek naar wat er op het net bestond, maar ik kon geen equivalent van mijn onderzoek vinden.
Bij voorbaat dank
Hallo
Kijk in de taakplanner om te zien of er een paar dingen zijn.
Batch converter (tool van de mycadservices premium suite)
Uitleg hier, zie aan het einde van de video voor de mogelijkheden voor het exporteren van plaatwerkdelen in dxf: http://youtu.be/wJeSg5cO06s
Helaas heb ik alleen de standaardversie van SW, dus ik wilde een macro doornemen.
Dit is de basisfunctie die is opgenomen in Solidworks (zonder dat er een tool van derden nodig is...):
Dan, kijkend naar de functies aan de macrokant, zou er een manier moeten zijn om het te automatiseren ...
Ik kan niet helpen met de macro kant.
Bedankt Olivier, ik ken deze methode, maar als je een map van verschillende stukken hebt om om te zetten in een .dxf is het super lang...
Dus ik wilde op dezelfde manier als deze macro => dwg naar pdf , maar om van Sldprt naar .dxf te gaan
Hallo
Hier is een stukje code waarmee u vanaf een sldprt het uitgevouwen van een plaatwerk in dxf kunt opnemen.
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Dim stPath As String
Dim lgFichier As Long
Dim blretval As Boolean
Set swApp = Application.SldWorks
'on récupére le document actif
Set swmodel = swApp.ActiveDoc
If Not swmodel Is Nothing Then
'on vérifie que le fichier est enregisté
If swmodel.GetPathName = "" Then
MsgBox "Veuillez enregistrer votre document avant de lancer la macro", vbInformation
End
Else
'on récupére l'emplacement du fichier
stPath = swmodel.GetPathName
'on récupére le nombre de caractére jusqu'au . de l'extension
lgFichier = InStrRev(stPath, ".", -1, vbTextCompare) - 1
'on récupére le chemin sans l'extention
If lgFichier > 0 Then
stPath = Left(stPath, lgFichier)
End If
End If
'si le document est une pièce
If swmodel.GetType = swDocPART Then
'on créer le déplié
blretval = swmodel.ExportFlatPatternView(stPath & ".DXF", 1)
'on créer le DXF
blretval = swmodel.SaveAs3(stPath & ".DXF", 0, 0)
End If
End If
End Sub
Je moet nog steeds de code schrijven voor het analysegedeelte van de map, het onderdeel laden en vervolgens dit deel sluiten.
Vriendelijke groeten
Dank u voor uw hulp,
Mijn programma werkt nu! Het opent, slaat de dxf op en sluit alle onderdelen in de geselecteerde map.
Ik deel
'-------------------------------------------------------------------------------------------------------------
Optie Expliciete
Privé Const BIF_RETURNONLYFSDIRS zo lang = &H1
Privé Const BIF_DONTGOBELOWDOMAIN zo lang = &H2
Privé Const BIF_RETURNFSANCESTORS zo lang = &H8
Privé Const BIF_BROWSEFORCOMPUTER zo lang = &H1000
Privé Const BIF_BROWSEFORPRINTER zo lang = &H2000
Privé Const BIF_BROWSEINCLUDEFILES zo lang = &H4000
Privé Const MAX_PATH zo lang = 260
Functie BrowseFolder (optioneel bijschrift als tekenreeks, optionele InitialFolder als tekenreeks) als tekenreeks
Dim SH als Shell32.Shell
Dim F As Shell32.Map
Stel SH in = Nieuwe Shell32.Shell
Stel F = SH in. BrowseforFolder(0&, Bijschrift, BIF_RETURNONLYFSDIRS, InitialFolder)
Zo niet, dan is F niets, dan is
Als F = "Desktop" dan
BrowseFolder = Over ("GEBRUIKERSPROFIEL") & "\Bureaublad"
Anders
BrowseFolder = F.Items.Item.Path
Einde als
Einde als
Functie beëindigen
Sub hoofd()
Dim swApp als SldWorks.SldWorks
Dim swmodel als SldWorks.ModelDoc
Dim sFileName als tekenreeks
Dim pad als snaar
Dim nErrors zo lang
Dim nWaarschuwingen zo lang mogelijk
Dim swPart As SldWorks.PartDoc
Dim PartNoDes als snaar
Dim stPath als snaar
Dim lgFile zo lang
Dim blretval Als Booleaanse
Stel swApp = Toepassing.SldWorks in
' Stel swExportPDFData = swApp.GetExportFileData(1) in
Path = BrowseFolder("Selecteer een pad/map")
Als pad = "" dan
MsgBox "Selecteer het pad en probeer het opnieuw"
Einde
Anders
Pad = Pad + "\"
Einde als
sFileName = Dir(Pad & "*.sldprt")
Doen tot sFileName = ""
Stel swmodel in = swApp.OpenDoc6(Pad + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Stel swmodel = swApp.ActiveDoc in
Stel swPart in = swApp.ActiveDoc
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 het ontvouwde
blretval = swmodel. ExportFlatPatternView(stPath & ". DXF", 1)
De DXF werd opgericht
blretval = swmodel. SaveAs3(stPath & ". DXF", 0, 0)
Einde als
swApp.QuitDoc swPart.GetPathName
Set swPart = Niets
Set swmodel = Niets
sFileName = Dir
Strik
MsgBox "Alles klaar"
Einde Sub
'-------------------------------------------------------------------------------------------------------------