Suite von nummerierten Schildern, lasergeschnitten

Out of category
1

Ich muss eine Reihe von nummerierten Platten herstellen, die mit einem Laser geschnitten werden Ich suche nach einer Lösung, um das DXF auf Solidworks automatisch zu generieren Vielen Dank im Voraus

2

Hallo;

Sie sollten in der Lage sein, Ihre Massenexporte mit dem " Solidworks Task Scheduler " durchzuführen

image
Bild1366×655 81.8 KB

Ansonsten glaube ich, dass schon einige Makros im Forum herumliegen...

Das Makro von @js_1207

Transkript unten:

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

Herzliche Grüße

2 „Gefällt mir“
3

Hier ist, was ich in den Archiven gefunden habe:
Indem Sie beispielsweise der Methode von Lynk folgen:

Dann zum Exportieren über den Taskplaner cf Methode @Maclane oder über Makro oder Batchconverter (einmonatige Testversion herunterladbar)
Und das hier etwas ausführlicher:

Oder ohne SW:

MyCADtools-Link für das Testprogramm Batchconverter:

4

… Zusätzliche Antwort @sbadenis :grin:
Ich kümmere mich um die *.dxf und du kümmerst dich dann um die Nummerierung...?

1 „Gefällt mir“