Bonjour,
Je cherche une macro (ou un bout de programme VBA) qui depuis une mise en plan SolidWorks ferait la chose suivante:
Plan commence par P non?
Oki, je sors...;-)
Bonne remarque @max59 , alors plutot:
Enregistrement en DWG (version R12) des feuilles avec la syntaxe "PXX"
XX étant 2 chiffres
Est ce que un export de chaque page PXX en un fichier distinct par page peut convenir ?
@MaD:
chaque page PXX doit être un fichier distinct.
Sur chacune de ces pages se trouve la représentation d'un corps pour découpe plasma.
J'aimerais donné comme nom de fichier: NOM DE FICHIER MEP-NOM DE LA FEUILLE
Pour ce qui est de l'enregistrement en PDF des feuilles "Plan_", idéalement il faudrait toutes les feuilles soient regrouper dans le même PDF.
Pour le nom du fichier PDF: NOM DE FICHIER MEP-DESCRIPTION (propriété personnalisée dans le fichier pièce)
Bon alors j'ai ce code a copier
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim Filename As String
Dim lErrors As Long
Dim lWarnings As Long
Dim strSheetName() As String
Dim varSheetName As Variant
'
Dim swDraw As SldWorks.DrawingDoc
Dim vSheetNames As Variant
'
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim File As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' ajout controle du bon fichier
If Part Is Nothing Then
MsgBox "Aucun fichier n'est actuellement ouvert."
Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
MsgBox "Cette macro ne s'applique que sur une mise en plan"
Exit Sub
End If
File = Part.GetPathName
If File = "" Then
MsgBox "Cette macro necessite que le fichier soit préalablement enregistré"
Exit Sub
End If
Dim Filepath As String
Dim Filename As String
Filepath = Left(File, InStrRev(File, "\"))
Filename = Mid(File, Len(Filepath) + 1, Len(File) - (7 + Len(Filepath)))
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swDraw = Part
vSheetNames = swDraw.GetSheetNames
Dim i As Long
Dim j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
strSheetName(j) = vSheetNames(i)
j = j + 1
End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
'DWG
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R12)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, 0)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, 1)
longstatus = Part.SaveAs3(Filepath & "\" & Filename & ".DWG", 0, 0)
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
End If
Next
End Sub
Essaie le d'abord sur une copie de plan on ne sait jamais et dit moi si cela correspond
Petit ajout pour renomer les DWG
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
Else
Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Name Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG" As Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
End If
Je te laisse le replacer dans le code precedent :)
et pour le nom du PDF
Dim swCustProp As CustomPropertyManager
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & "-" & swCustProp.Get("LBM_REV") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
ou LBM_REV est le nom de ta propriete :)
Tient nous au courant
Moi j'ai une erreur dans l'execution de la MACRO:
le résultat est le suivant:
La propriété "description" n'apparait pas dans le nom du fichier PDF
pour les DWG, (je pense que c'est le résultat de l'erreur), j'aimerais faire apparaitre le nom des feuilles (P01,etc.....) à la fin.
Effectivement, même erreur sur ta nouvelel macro alors que sur la 1ere pas de soucis
Je voit ce qui plante lors de mes test il n'arrivait pas a renomer si le fichier existait donc je le suprimait mais si il n'existe pas il n'arrive pas a le suprimer je rajout un controle de fichier
Avec la correction sur la ligne en question
If Len(Dir(Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG")) > 0 Then Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Sa devrait etre mieux :)
Pour la propriete il s'agit d'une propriete personnalisé ou de celle intégré dans Solidworks ?
c'est une propriété perso ("DESCRIPTION") de la pièce (attention, cette propriété n'estpas dans la mise en plan)
Je n'y comprends pas grand chose en VBA, mais en fouillant dans des macros que j'ai récupéré, je me demande si ca ne correspond pas à ça:
Okay j'avais pas compris sa :/ ok je regarde
Il n'y a qu'un seul composant par mise en plan ou plusieur ?
1 seul composant par MEP oui
Ok alors essaie ceci :)
Merci à nos ami RICAIN :) https://forum.solidworks.com/message/431752#comment-431752
Macro en PJ