Bonjour,
J'ai un souci avec ma macro et avec l'export (Enregistrer sous...) en PDF de mes mises-en-plan qui contiennent des symboles de soudure : le trait discontinu passe en Continu, comme dans l'image.
Si j'imprime le fichier en PDF, avec Microsoft to PDF ou Adobe PDF je n'ai pas le problème.
Avez-vous une solution ?
Ci-dessous ma macro.
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim lErrors As Long
Dim lWarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
PathName = UCase(swModel.GetPathName)
FilePath = Left(PathName, InStrRev(PathName, "\"))
FileTyp = swModel.GetType
'MsgBox (FileTyp)
Select Case FileTyp
Case swDocDRAWING
swModel.Extension.SaveAs FilePath & GetFilename(swModel.GetPathName) & "-" & swModel.CustomInfo2("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
Case swDocASSEMBLY
swModel.Extension.SaveAs FilePath & GetFilename(swModel.GetPathName) & "-Assy-" & swModel.CustomInfo2("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
Case swDocPART
swModel.Extension.SaveAs FilePath & GetFilename(swModel.GetPathName) & "-Part-" & swModel.CustomInfo2("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
Case Else
swModel.Extension.SaveAs FilePath & GetFilename(swModel.GetPathName) & "-" & swModel.CustomInfo2("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
End Select
MsgBox ("Le PDF a été généré, et devrait s'ouvrir automatiquement. Bonne journée !")
End Sub
Function GetFilename(strPath As String) As String
Dim strTemp As String
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function
Merci d'avance !
symbole_soudure.jpg