Muszę wykonać serię ponumerowanych płyt wyciętych laserem Szukam rozwiązania, aby automatycznie wygenerować DXF na solidworks, z góry dziękuję
Witam;
Powinno być możliwe wykonywanie eksportu zbiorczego za pomocą " Harmonogramu zadań Solidworks "
W przeciwnym razie wydaje mi się, że na forum leżą już jakieś makra...
Na przykład makro @js_1207
Transkrypcja poniżej:
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String
Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Set SH = New Shell32.Shell
Set F = SH.BrowseforFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
If F = "Desktop" Then
BrowseFolder = Environ("USERPROFILE") & "\Desktop"
Else
BrowseFolder = F.Items.Item.Path
End If
End If
End Function
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc
Dim sFileName As String
Dim Path As String
Dim nErrors As Long
Dim nWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim PartNoDes As String
Dim stPath As String
Dim lgFichier As Long
Dim blretval As Boolean
Set swApp = Application.SldWorks
' Set swExportPDFData = swApp.GetExportFileData(1)
Path = BrowseFolder("Select a Path/Folder")
If Path = "" Then
MsgBox "Please select the path and try again"
End
Else
Path = Path + "\"
End If
sFileName = Dir(Path & "*.sldprt")
Do Until sFileName = ""
Set swmodel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swmodel = swApp.ActiveDoc
Set swPart = swApp.ActiveDoc
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
swApp.QuitDoc swPart.GetPathName
Set swPart = Nothing
Set swmodel = Nothing
sFileName = Dir
Loop
MsgBox "All Done"
End Su
Pozdrowienia
2 polubienia
Oto, co znalazłem w archiwach:
Postępując zgodnie z metodą Lynka, na przykład:
Następnie, aby wyeksportować za pomocą harmonogramu zadań, metody cf @Maclane lub za pomocą makra lub konwertera wsadowego (do pobrania miesięcznej wersji próbnej)
A ten trochę bardziej szczegółowy:
Lub bez oprogramowania:
Link MyCADtools do narzędzia próbnego Batchconverter:
