I have a macro that goes smoothly ... but where nothing happens. I don't really understand why and where it gets stuck. If anyone has an idea?
I put comments to explain what I'm trying to do there. The idea is to save each sheet of my DRW in DXF and PDF in the right name in the right directory.
Sub Save() Dim swapp As SldWorks.SldWorks Dim swdoc As SldWorks.ModelDoc2 Dim Swdraw As SldWorks.ModelDoc Dim swSheet As SldWorks.Sheet Dim vSheetNames As Variant Dim Nbfeuille As Variant Set swapp = Application.SldWorks Set swdoc = swapp. ActiveDoc Set Swdraw = swdoc Set swSheet = Swdraw.GetCurrentSheet 'Confirmation message ret = MsgBox("do you want to convert this drawing to DXF and PDF?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Laser Conversion") If ret = vbCancel Then End Registration new name Do newname = InputBox("Please specify the new name:", "blabla", newname) If StrPtr(newname) = 0 Then MsgBox "procedure cancelled" Exit Sub End If 'Checking Forbidden Character 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("Warning, the name contains at least one of the forbidden characters \/:*?"" <>!" & vbNewLine & vbNewLine & "Please indicate the new name: ", "save-under by LPR", newname) Loop Loop While newname = " " 'Registration Dossier Do FilePath = InputBox("Specify the path", "record folder", FilePath) If StrPtr(FilePath) = 0 Then MsgBox "procedure cancelled" Exit Sub End If 'Adding the \ to the end of the folder name If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\" If Dir$(FilePath) <> "" Then EXISTS = 1 Else: MsgBox "the directory doesn't exist, please create it" Debug.Print Dir$(FilePath) End If Loop While EXISTS <> 1 'Indicates the number of sheets Nbfeuille = swdoc. GetSheetCount For i = 0 To Nbfeuille swdoc. SheetPrevious Next i Moving to the next sheet if < to the total number For i = 0 To varSheetCount - 1 If i <> 0 Then swmodel. SheetNext End If Recording in DXF and PDF swdoc. SaveAs (FilePath + newname + "_" + i + ".dxf") swdoc. SaveAs (FilePath + newname + "_" + i + ".pdf") Next i End Sub
Hello I would like to save my parts in DXF as well but since the Part file, I tried to hack your program to adapt it but nothing works except the message boxes I have no results, someone can take a look at my code, or give me one that already works well for this use
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
The macro is made for MEPs and you transform it for a room, no surprise that it doesn't work. Moreover, the subject being closed since 2014 I invite you to create your own topic with this here as a reference. I guess that there are already macros to export in dxf from a sheet metal part and that this one is therefore not the most suitable.
… 9 years later... (you shouldn't dig up old topics, especially if they are already in "solved"...
To export a volume part (SLDPRT) in DXF: replace the "saveas" command with: ExportToDWG2 (export without unfolded) or by ExportFlatPatternView (export with flattening)...
