Ma communauté

Accédez à plus de ressources avec myCADservices

  • Support personnalisé
  • Téléchargement CAO
  • Composants 3D
  • Applications premium
En savoir plus sur myCADservices

macro DXF PDF
  • Topic:
    • SOLIDWORKS

  • 5 réponses
  • 2297 vues

Par coin37coin Le 11 juillet 2014

Hello.

 

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

Meilleure réponse

.PL | 52628 point(s)

Salut,

Pour le débogage, voir ce lien :

Voir ce lien : http://www.tomshardware.fr/forum/id-1348092/tutoriel-excel-macro-vba-debogage.html

Essaye de faire un point d'arrêt pour les lignes :

 

swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf")
swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf")

 

Le programme y passe bien ?

 

Si non, regarde pourquoi.

 

Si oui, fais un debug.print juste avant les lignes pour voir ce qu'elles contiennent :

debug.print FilePath + newname + "_" + i + ".dxf"

Les autres réponses

.PL | 52628 point(s)

Salut,

Pour le débogage, voir ce lien :

Voir ce lien : http://www.tomshardware.fr/forum/id-1348092/tutoriel-excel-macro-vba-debogage.html

Essaye de faire un point d'arrêt pour les lignes :

 

swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf")
swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf")

 

Le programme y passe bien ?

 

Si non, regarde pourquoi.

 

Si oui, fais un debug.print juste avant les lignes pour voir ce qu'elles contiennent :

debug.print FilePath + newname + "_" + i + ".dxf"

Joss.G | 5187 point(s)

Autant pour moi,

Je ne peux pas t'aider alors, bonne chance ;)

Cdt,

Joss

coin37coin | 4912 point(s)

Encore quelques bug, mais j'approche du but ultime (haaaa !)

 

Bref, merci pour les info sur la résolution de bug

Rejoignez la communauté dès maintenant

ou

Créez votre compte :