Allo Groupe,
Je suis nouveau sur ce forum. Je travaille avec les mécano-soudés, c'est-à-dire avec des corps multiples. J'aimerais sauvegarder certains corps en fichier STEP, IGES car mon contrôleur de presse ne peux ouvrir que ce type de fichier. Il y a bien la fonction enregistre corps (insertion/ fonction/enregistre corps) mais elle me permet de sauvegarder seulement en *.SLDPRT
Avez vous des suggestions pour une autre fonction? Sinon, y a des pro de la macro dans le coin, je dois vous avouer que je ne mis connais pas trop à ce sujet mais je vois bien une macro qui insèrerait un corps dans une nouvelle pièce sans l'enregistrer et qui sauvegarderait la pièce en STEP pas la suite en utilisant le nom prédéfini dans un paramètre.
Merci à tous
Bonjour,
Il vous suffit de créer une configuration et de supprimer (avec la fonction "supprimer/garder le corps") ce dont votre contrôleur n'a pas besoin et de l'enregistrer en STEP.
3 « J'aime »
Bonjour,
Essaye ca:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & " - " & swBody.Name & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub
4 « J'aime »
Allo Jérome P,
Tu as bien compris ce que je voulais malheureusement à la ligne pour sélectionner un corps, ça bloque. J'ai bien la boite qui s'ouvre mais je ne peux faire aucune sélection, je peux juste appuyer sur OK et ça mets fin à la macro. J'espère que tu peux m'aider. Merci infiniment.
WOWOWOOWOOOOO
Je viens de catcher que je dois sélectionner le corps avant de lancer la macro, c'est trop ca coche. Je sais pas si tu peux m'aider à modifier la fonction mais j'aimerais seulement ajouter une boite de dialogue pour permettre de renommer le fichier ou mieux encore utiliser le nom du groupe de corps plutot que le nom du corps. Dans mon exemple, j'aimerais utiliser le nom "30320.1 - PL0.25" plutôt que le nom par défaut "enregistrer le corps1", voir image
Merci
capture.png
Ok. Essaye ça:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim FilePath As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then MsgBox "Ouvrir une pièce": Exit Sub
If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox "Ouvrir une pièce": Exit Sub
Set swPart = swModel
If swModel.SelectionManager.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSOLIDBODIES Then MsgBox "sélectionner un corps": Exit Sub
Set swBody = swModel.SelectionManager.GetSelectedObject6(1, -1)
If swBody Is Nothing Then MsgBox "sélectionner un corps": Exit Sub
swBody.Select2 False, Nothing
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ".STEP"
swPart.SaveToFile3 FilePath, swSaveAsOptions_e.swSaveAsOptions_Silent, swCutListTransferOptions_e.swCutListTransferOptions_FileProperties, False, Empty, Empty, Empty
Set swModel = swApp.ActiveDoc
swApp.CloseDoc swModel.GetTitle
End Sub
Function GetCutList(swModel As SldWorks.ModelDoc2, BodyName As String) As String
Dim swFeat As SldWorks.Feature
Dim swBodyFolder As SldWorks.BodyFolder
Dim swBody As SldWorks.Body2
Dim vBodies As Variant
Dim vBody As Variant
Set swFeat = swModel.FirstFeature
While Not swFeat Is Nothing
If swFeat.GetTypeName = "CutListFolder" Then
Set swBodyFolder = swFeat.GetSpecificFeature
vBodies = swBodyFolder.GetBodies
If Not IsEmpty(vBodies) Then
For Each vBody In vBodies
Set swBody = vBody
If swBody.Name = BodyName Then
GetCutList = swFeat.Name
Exit Function
End If
Next
End If
End If
Set swFeat = swFeat.GetNextFeature
Wend
GetCutList = BodyName
End Function
2 « J'aime »
OK ca fonctionne 50-50 :(
En effectuant des tests, la fonction "getcutlist" fonctionne bien car la variable "FilePath" est toujours bonne. Par contre, le "savetofile3" ne fonctionne pas. Je vois bien à l'écran que la fonction s'exécute car il ouvre la pièce mais le fichier n'apparait pas dans le répertoire.
Par contre, en effectuant des tests, je me suis rendu compte d'une chose:
Premièrement, J'utilise la propriété du répertoire "description" et SW renomme mes répertoire automatiquement. (voir caption2) mais si je n'ai pas encore éditer ce paramètre, par exemple, le dernier répertoire de pièce (articles-liste-des pieces-soudés19) ou bien si je le renomme manuellement. par exemple le premier répertoire (test) alors la macro fonction bien et le fichier step apparait dans le répertoire.
Est-ce que tu crois que ca peut-être les crochets que SW inscrits à la fin par défaut et qui servent à je ne sais quoi?
du type "...<#>..."
Merci.
capture2.png
Effectivement si il y a des caractères non valide pour le nom de fichier, il ne va pas être sauvegardé.
Remplace: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & GetCutList(swModel, swBody.Name) & ".STEP"
par: FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\")) & RegexStr(GetCutList(swModel, swBody.Name)) & ".STEP"
et ajoute la fonction:
Function RegexStr(ByVal Str As String) As String
Str = Split(Str, "<")(0)
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
With regex
.Pattern = "[^-_ a-zA-Z0-9]"
.Global = True
.IgnoreCase = True
.MultiLine = False
End With
RegexStr = regex.Replace(Str, "")
End Function
1 « J'aime »
Wow super!!!
J'ai ajouté un point à la fin de regex.pattern (.Pattern = "[^-_ a-zA-Z0-9.]") car la fonction les effaçait (Merci google).
Merci à toi pour ton support, je n'y serai jamais arriver seul.
Tu es un dieu de la programmation et j'aimerais bien devenir un de tes disciples. :)
Merci encore, tu fais ma journée...
2 « J'aime »