Ich habe ein Makro, das reibungslos funktioniert ... Aber wo nichts passiert. Ich verstehe nicht wirklich, warum und wo es stecken bleibt. Hat jemand eine Idee?
Ich schreibe Kommentare, um zu erklären, was ich dort zu tun versuche. Die Idee ist, jedes Blatt meines DRW in DXF und PDF unter dem richtigen Namen im richtigen Verzeichnis zu speichern.
Sub Speichern() Dim swapp als SldWorks.SldWorks Dim swdoc As SldWorks.ModelDoc2 Dim Swdraw As SldWorks.ModelDoc Dim swSheet als SldWorks.Sheet Dimmen von vSheetNames als Variante Dim Nbfeuille als Variante Set swapp = Application.SldWorks Legen Sie swdoc = swapp fest. ActiveDoc (Englisch) Setze swdraw = swdoc Set swSheet = Swdraw.GetCurrentSheet "Bestätigungsmeldung ret = MsgBox("Möchten Sie diese Zeichnung in DXF und PDF konvertieren?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Laserkonvertierung") Wenn ret = vbAbbrechen, dann Ende Registrierung neuer Name Tun newname = InputBox("Bitte geben Sie den neuen Namen an:", "blabla", newname) Wenn StrPtr(newname) = 0 dann MsgBox "Vorgang abgebrochen" Sub beenden Ende, wenn 'Überprüfen von Fenstern mit verbotenen Zeichen Do while InStr(newname, "/") > 0 Or InStr(newname, "*") > 0 Or InStr(newname, "?") > 0 Or InStr(newname, "<") > 0 Or InStr(newnam, ">") > 0 Or InStr(newnam, "!") > 0 newname = InputBox("Warnung, der Name enthält mindestens eines der verbotenen Zeichen \/:*?"" <>!" & vbNewLine & vbNewLine & "Bitte geben Sie den neuen Namen an: ", "save-under by LPR", newname) Schleife Schleife While newname = " " "Registrierungsdossier Tun FilePath = InputBox("Geben Sie den Pfad an", "Datensatzordner", FilePath) Wenn StrPtr(FilePath) = 0, dann MsgBox "Vorgang abgebrochen" Sub beenden Ende, wenn "Durch Hinzufügen des \ am Ende des Ordnernamens If Right(FilePath, 1) <> "\" then FilePath = FilePath & "\" Wenn Dir$(FilePath) <> "" dann EXISTIERT = 1 Ansonsten: MsgBox "das Verzeichnis existiert nicht, bitte erstellen Sie es" Debug.Print Dir$(Dateipfad) Ende, wenn Schleife, während EXISTS <> 1 "Gibt die Anzahl der Blätter an Nbfeuille = swdoc. GetSheetCount (Englisch) Für i = 0 Bis Nbfeuille SWDOC. BlattVorherige Seite Weiter i Wechseln zum nächsten Blatt, wenn < zur Gesamtzahl Für i = 0 Bis varSheetCount - 1 Wenn ich 0 <>, dann sw-Modell verwenden. BlattWeiter Ende, wenn Aufzeichnung in DXF und PDF SWDOC. Speichern unter (Dateipfad + neuer Name + "_" + i + ".dxf") SWDOC. Speichern unter (Dateipfad + neuer Name + "_" + i + ".pdf") Weiter i Ende Sub
Da ich nicht viel über die Erstellung von Makros wusste, habe ich nur ein anderes Makro gefunden, das das tun kann, was Sie erreichen möchten... Ob es Ihnen helfen kann?
Hallo Ich möchte meine Teile auch in DXF speichern, aber seit der Part-Datei habe ich versucht, Ihr Programm zu hacken, um es anzupassen, aber nichts funktioniert außer den Meldungsfeldern Ich habe keine Ergebnisse, jemand kann einen Blick auf meinen Code werfen oder mir einen geben, der bereits gut für diese Verwendung funktioniert
Sub Enregistrer()
Dim swapp As SldWorks.SldWorks
Dim swdoc As SldWorks.ModelDoc2
Dim SwPart As SldWorks.ModelDoc
Set swapp = Application.SldWorks
Set swdoc = swapp.ActiveDoc
Set SwPart = swdoc
'Message de confirmation
ret = MsgBox("voulez-vous convertir cette piece en DXF?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Conversion Laser")
If ret = vbCancel Then End
'Enregistrement nouveau nom
Do
newname = InputBox("nom du dxf:", "blabla", newname)
If StrPtr(newname) = 0 Then
MsgBox "procédure annulée"
Exit Sub
End If
'Verification caractere interdit Windows
Do While InStr(newname, "/") > 0 Or InStr(newname, "*") > 0 Or InStr(newname, "?") > 0 Or InStr(newname, "<") > 0 Or InStr(newnam, ">") > 0 Or InStr(newnam, "!") > 0
newname = InputBox("Attention, le nom contient au moins un des caractère interdits \/:*?""<>!" & vbNewLine & vbNewLine & "Merci d'indiquer le nouveau nom: ", "enregistrer-sous par LPR", newname)
Loop
Loop While newname = " "
'Dossier d'enregistrement
Do
FilePath = InputBox("Indiquez le chemin d'accés", "dossier enregistrement", FilePath)
If StrPtr(FilePath) = 0 Then
MsgBox "procédure annulée"
Exit Sub
End If
'Ajout du \ à la fin du nom de dossier
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
If Dir$(FilePath) <> "" Then
EXISTE = 1
Else: MsgBox "le répertoire n'existe pas, merci de le créer"
Debug.Print Dir$(FilePath)
End If
Loop While EXISTE <> 1
'Enregistrement en DXF
swdoc.SaveAs (FilePath + newname + "_" + ".dxf")
End Sub
Das Makro ist für Europaabgeordnete gemacht und man verwandelt es in einen Raum, keine Überraschung, dass es nicht funktioniert. Da das Fach seit 2014 geschlossen ist, lade ich Sie ein, Ihr eigenes Thema mit diesem hier als Referenz zu erstellen. Ich vermute, dass es bereits Makros gibt, die in DXF von einem Blechteil exportiert werden können und dass dieses daher nicht das geeignetste ist.
… 9 Jahre später... (Du solltest alte Themen nicht ausgraben, vor allem wenn sie bereits in "gelöst" sind...
Um ein Volumenteil (SLDPRT) in DXF zu exportieren, ersetzen Sie den Befehl "saveas" durch: ExportToDWG2 (Export ohne Entfaltung) oder durch ExportFlatPatternView (Export mit Abflachung)...
