J'ai une macro qui se déroule sans accro ... mais où rien ne se passe. Je ne comprends pas bien pourquoi et où ça coince. Si quelqu'un à une idée ?
J'ai mis des commentaires pour expliquer ce que je tente d'y faire. Dans l'idée, c'est d'enregistrer chaques feuilles de mon DRW en DXF et en PDF dans le bon nom au bon repertoire.
Sub Enregistrer() 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 'Message de confirmation ret = MsgBox("voulez-vous convertir cette mise en plan en DXF et PDF ?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Conversion Laser") If ret = vbCancel Then End 'Enregistrement nouveau nom Do newname = InputBox("Merci d'indiquer le nouveau nom:", "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 'Indique le nombre de feuille Nbfeuille = swdoc.GetSheetCount For i = 0 To Nbfeuille swdoc.SheetPrevious Next i 'passage à la feuille suivante si < au nombre total For i = 0 To varSheetCount - 1 If i <> 0 Then swmodel.SheetNext End If 'Enregistrement en DXF et PDF swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf") swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf") Next i End Sub
N'y connaissant pas grand-chose en création de macro, j'ai seulement trouvé une autre macro qui peut faire ce que vous chercher à réaliser... Si ça peut vous aider ?
Bonjour,
j’aimerais enregistrer mes piece en DXF également mais depuis le fichier Part, j’ai essayer de bidouiller ton programme pour l’adapter mais rien n’y fais a part les message box je n’ai aucun résultat , quelqu’un peut jeter un œil a mon code , ou m’en donner un qui marche déjà bien pour cette utilisation
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
La macro est réalisé pour des MEP et tu la transforme pour une pièce pas surprenant que cela ne fonctionne pas.
De plus le sujet étant clôturer depuis 2014 je t’invite à créer ton propre sujet avec celu-ici en référence.
Je suppose d’ailleurs qu’il existe déjà des macro pour exporté en dxf depuis une pièce de tôlerie et que celle-ci ne soit donc pas la plus adapté.
…9 ans plus tard…
(il ne faut pas déterrer de vieux topics, surtout s’ils sont déjà en "résolu "…
pour exporter une pièce volumique (sldprt) en dxf: remplacer la commande « saveas » par: ExportToDWG2 (export sans deplié)
ou par ExportFlatPatternView (export avec mise à plat)…
