Modification macro "fixer ensembles et sous ensembles"

Hello les Collègues,

j’ai une macro qui fixe les ensembles et sous ensembles pour les fichiers importés et je m’y connais pas assez bien pour la modifier comme je le voudrais. J’aimerais que en plus qu’elle active « Arrêtes en mode image ombrée » et qu’elle m’enregistre l’assemblage; ci-joint la dite macro pour mordication si réalisable :innocent: :innocent: :innocent:

Option Explicit

Dim swApp As SldWorks.SldWorks

Sub main()
    Dim swModel As ModelDoc2
    Dim swAssy As AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    TransverseComponents swAssy
    swApp.SendMsgToUser "Terminé" & Chr(10) & ":-)"
    swAssy.ForceRebuild2 (True)
End Sub

Sub TransverseComponents(swAssy As AssemblyDoc)
    Dim vComponents As Variant
    Dim i As Integer
    Dim swComponent As Component2
    Dim swModel As ModelDoc2
    Dim swAssembly As AssemblyDoc
    
    vComponents = swAssy.GetComponents(True)
    For i = 0 To UBound(vComponents)
        Set swComponent = vComponents(i)
        Set swModel = swComponent.GetModelDoc2
        Debug.Print swComponent.Name2
        swComponent.Select4 False, Nothing, False
        swAssy.FixComponent
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocASSEMBLY Then
                Set swAssembly = swModel
                TransverseComponents swAssembly
            End If
        End If
    Next i
End Sub

Bonjour;

Voici une macro complète (a ajouter à la votre) pour les « arrêtes en mode ombré » et l’enregistrement:

Option Explicit

Public Enum swViewDisplayMode_e

swViewDisplayMode_Wireframe = 1

swViewDisplayMode_HiddenLinesRemoved = 2

swViewDisplayMode_HiddenLinesGrayed = 3

swViewDisplayMode_Shaded = 4

swViewDisplayMode_ShadedWithEdges = 5 ' only valid for a part

End Enum

Sub main()

Const nNewDispMode As Long = swViewDisplayMode_ShadedWithEdges



Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModView As SldWorks.ModelView

Dim bRet As Boolean

Dim swerror As Long

Dim swwarnings As Long

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swModView = swModel.ActiveView



swModView.DisplayMode = nNewDispMode

Debug.Assert nNewDispMode = swModView.DisplayMode

swModel.ShowNamedView2 "*Isometric", 7

swModel.ViewZoomtofit2

swModel.ForceRebuild3 False

Debug.Print "File = " & swModel.GetPathName
Debug.Print " Display mode = " & swModView.DisplayMode

Debug.Print " ModelView hWnd = " & swModView.GetViewHWnd

Debug.Print " ModelView DIB = " & swModView.GetViewDIB

swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, swerror,swwarnings

swApp.CloseDoc (swApp.ActiveDoc.GetPathName)


End Sub

Cordialement.

1 « J'aime »

Bonjour @Maclane ,

j’ai collé le bout de la macro à la mienne mais rien ne ce passe quand je la lance.

Option Explicit

Dim swApp As SldWorks.SldWorks

Sub main()
    Dim swModel As ModelDoc2
    Dim swAssy As AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    TransverseComponents swAssy
    swApp.SendMsgToUser "Terminé" & Chr(10) & ":-)"
    swAssy.ForceRebuild2 (True)
End Sub

Sub TransverseComponents(swAssy As AssemblyDoc)
    Dim vComponents As Variant
    Dim i As Integer
    Dim swComponent As Component2
    Dim swModel As ModelDoc2
    Dim swAssembly As AssemblyDoc
    
    vComponents = swAssy.GetComponents(True)
    For i = 0 To UBound(vComponents)
        Set swComponent = vComponents(i)
        Set swModel = swComponent.GetModelDoc2
        Debug.Print swComponent.Name2
        swComponent.Select4 False, Nothing, False
        swAssy.FixComponent
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocASSEMBLY Then
                Set swAssembly = swModel
                TransverseComponents swAssembly
            End If
        End If
    Next i
End Sub


Option Explicit

Public Enum swViewDisplayMode_e

swViewDisplayMode_Wireframe = 1

swViewDisplayMode_HiddenLinesRemoved = 2

swViewDisplayMode_HiddenLinesGrayed = 3

swViewDisplayMode_Shaded = 4

swViewDisplayMode_ShadedWithEdges = 5 ' only valid for a part

End Enum

Sub main()

Const nNewDispMode As Long = swViewDisplayMode_ShadedWithEdges



Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swModView As SldWorks.ModelView

Dim bRet As Boolean

Dim swerror As Long

Dim swwarnings As Long

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Set swModView = swModel.ActiveView



swModView.DisplayMode = nNewDispMode

Debug.Assert nNewDispMode = swModView.DisplayMode

swModel.ShowNamedView2 "*Isometric", 7

swModel.ViewZoomtofit2

swModel.ForceRebuild3 False

Debug.Print "File = " & swModel.GetPathName
Debug.Print " Display mode = " & swModView.DisplayMode

Debug.Print " ModelView hWnd = " & swModView.GetViewHWnd

Debug.Print " ModelView DIB = " & swModView.GetViewDIB

swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, swerror, swwarnings

swApp.CloseDoc (swApp.ActiveDoc.GetPathName)


End Sub

Bonjour;

Tu ne peut pas avoir deux macro nommées « Main () » dans le même module.
-option 1 : renomme une des macro (celle que je t’ai fournis) , puis faire appel à cette macro par la commande :
Call LeNomDeLaMacro
juste avec le « end sub » de la première « macro »

  • option numero 2:
    Integrer la nouvelle macro dans l’ancienne:
    Déplacer les déclaration de variable (les DIM…) de la nouvelle macro juste en dessous de la ligne « Option explicit » (tout en haut).
    supprimer les declaration en double…si besoin.
    et coller les lignes de la nouvelles macro avant le « end sub » de l’ancienne (en supprimant le Nom de la nouvelle macro et sa ligne de fermeture « end sub »…
    Ce qui devrait donner un truc du genre:
Option Explicit
Const nNewDispMode As Long = swViewDisplayMode_ShadedWithEdges
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModView As SldWorks.ModelView
Dim bRet As Boolean
Dim swerror As Long
Dim swwarnings As Long

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

Set swModView = swModel.ActiveView
Sub main()
    Dim swModel As ModelDoc2
    Dim swAssy As AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    TransverseComponents swAssy
    swApp.SendMsgToUser "Terminé" & Chr(10) & ":-)"
    swAssy.ForceRebuild2 (True)
End Sub

Sub TransverseComponents(swAssy As AssemblyDoc)
    Dim vComponents As Variant
    Dim i As Integer
    Dim swComponent As Component2
    Dim swModel As ModelDoc2
    Dim swAssembly As AssemblyDoc
    
    vComponents = swAssy.GetComponents(True)
    For i = 0 To UBound(vComponents)
        Set swComponent = vComponents(i)
        Set swModel = swComponent.GetModelDoc2
        Debug.Print swComponent.Name2
        swComponent.Select4 False, Nothing, False
        swAssy.FixComponent
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocASSEMBLY Then
                Set swAssembly = swModel
                TransverseComponents swAssembly
            End If
        End If
    Next i
End Sub


Option Explicit

Public Enum swViewDisplayMode_e
swViewDisplayMode_Wireframe = 1

swViewDisplayMode_HiddenLinesRemoved = 2
swViewDisplayMode_HiddenLinesGrayed = 3
swViewDisplayMode_Shaded = 4

swViewDisplayMode_ShadedWithEdges = 5 ' only valid for a part

End Enum

swModView.DisplayMode = nNewDispMode
Debug.Assert nNewDispMode = swModView.DisplayMode

swModel.ShowNamedView2 "*Isometric", 7
swModel.ViewZoomtofit2
swModel.ForceRebuild3 False

Debug.Print "File = " & swModel.GetPathName
Debug.Print " Display mode = " & swModView.DisplayMode
Debug.Print " ModelView hWnd = " & swModView.GetViewHWnd
Debug.Print " ModelView DIB = " & swModView.GetViewDIB

swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, swerror, swwarnings

swApp.CloseDoc (swApp.ActiveDoc.GetPathName)

End Sub

Nota: Si j’ai envoyé cette macro « autonome » c’est pour que tu puisse la tester avant d’essayer de l’intégrer dans une autre…( il faut toujours essayer avant « d’acheter »).

Cordialement.

je viens de copier et coller la macro mais rien ne se lance; dsl je suis une vrais quiche en VBA :woozy_face: :woozy_face: :woozy_face:

Bonjour,
Désolé je n’y connais rien en vba mais voici le code qui fonctionne en C#

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using System.Windows;
using System.Windows.Forms;

using SolidWorks.Interop.sldworks;
using SolidWorks.Interop.swconst;


namespace FixAssemblies
{
    public partial class SolidWorksMacro
    {
        public ModelDoc2 swDoc = null;
        public AssemblyDoc swAssembly = null;
        public object[] vComponents = null;
        public Component2 swComponent = null;
        public ModelView swModView = null;
        public int Errors;
        public int Warnings;

        public void Main()
        {
            swDoc = ((ModelDoc2)(swApp.ActiveDoc));
            swModView = (ModelView)swDoc.ActiveView;
            swAssembly = (AssemblyDoc)swDoc;
            TransverseComponents(swAssembly);
            swDoc = ((ModelDoc2)(swApp.ActiveDoc));
            swModView.DisplayMode = 5;
            swDoc.Save3((int)swSaveAsOptions_e.swSaveAsOptions_SaveReferenced, ref Errors, ref Warnings);
            swApp.SendMsgToUser2("Terminé\n:-)", (int)swMessageBoxIcon_e.swMbInformation, (int)swMessageBoxBtn_e.swMbOk);
            return;
        }

        public void TransverseComponents(AssemblyDoc swAssy)
        {
            vComponents = (object[])swAssembly.GetComponents(true);
            for (int i = 0; i < vComponents.Length; i++)
            {
                swComponent = (Component2)vComponents[i];
                swDoc = (ModelDoc2)swComponent.GetModelDoc2();
                swComponent.Select4(false, null, false);
                swAssembly.FixComponent();
                if (swDoc != null)
                {
                    if (swDoc.GetType() == (int)swDocumentTypes_e.swDocASSEMBLY)
                    {
                        swAssembly = (AssemblyDoc)swDoc;
                        TransverseComponents(swAssembly);
                    }
                }
            }
        }
        public SldWorks swApp;
    }
}

Cordialement,

Bonjour,

Voici le code modifié et fonctionnel sur SW2022.

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModView As SldWorks.ModelView
Dim bRet As Boolean
Dim swerror As Long
Dim swwarnings As Long

Public Enum swViewDisplayMode_e
swViewDisplayMode_Wireframe = 1

swViewDisplayMode_HiddenLinesRemoved = 2
swViewDisplayMode_HiddenLinesGrayed = 3
swViewDisplayMode_Shaded = 4

swViewDisplayMode_ShadedWithEdges = 5 ' only valid for a part

End Enum

Const nNewDispMode As Long = swViewDisplayMode_ShadedWithEdges
Sub main()

    Dim swModel As ModelDoc2
    Dim swAssy As AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    TransverseComponents swAssy
    swApp.SendMsgToUser "Terminé" & Chr(10) & ":-)"
    swAssy.ForceRebuild2 (True)
    Set swModView = swModel.ActiveView
    swModView.DisplayMode = nNewDispMode

Debug.Assert nNewDispMode = swModView.DisplayMode

swModel.ShowNamedView2 "*Isometric", 7
swModel.ViewZoomtofit2
swModel.ForceRebuild3 False

Debug.Print "File = " & swModel.GetPathName
Debug.Print " Display mode = " & swModView.DisplayMode
Debug.Print " ModelView hWnd = " & swModView.GetViewHWnd
Debug.Print " ModelView DIB = " & swModView.GetViewDIB

swModel.Save3 swSaveAsOptions_e.swSaveAsOptions_Silent, swerror, swwarnings

swApp.CloseDoc (swApp.ActiveDoc.GetPathName)

End Sub


Sub TransverseComponents(swAssy As AssemblyDoc)
    Dim vComponents As Variant
    Dim i As Integer
    Dim swComponent As Component2
    Dim swModel As ModelDoc2
    Dim swAssembly As AssemblyDoc
    
    vComponents = swAssy.GetComponents(True)
    For i = 0 To UBound(vComponents)
        Set swComponent = vComponents(i)
        Set swModel = swComponent.GetModelDoc2
        Debug.Print swComponent.Name2
        swComponent.Select4 False, Nothing, False
        swAssy.FixComponent
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocASSEMBLY Then
                Set swAssembly = swModel
                TransverseComponents swAssembly
            End If
        End If
    Next i
End Sub

2 « J'aime »

:grinning:Bravo @Cyril.f … on peut compter sur toi. :+1:
J’ai honte en regardant mon poste précédant maintenant… j’avais ré-écrit cette macro avec mes deux pieds gauches… :face_vomiting:

Cordialement.

1 « J'aime »

Ca arrive. J’ai également mis en prod une macro où j’avais oublié de supprimer un bout de code de test, du coup tout était en erreur pour les utilisateurs.

Bonjour @Cyril.f ,

merci pour la macro mais je ne suis pas sûr qu’elle enregistre les sous ASM et PRT car après l’avoir lancée elle fixe comme celle que j’ai et en validant la fenêtre qui confirme que tout est fixe elle ferme l’ASM et quand je le réouvre tout est vide même les sous ASM .

Peut-être testé un peu rapidement. Je n’ai pas d’export sous la main pour vérifier, possibilité d’en partager un?

@Cyril.f,

ci-joint un ASM teste

CUVE .STEP (3,2 Mo)

Je viens de comprendre, comme le fichier n’est pas enregistré il n’y a pas de sauvegarde à réaliser.
Deux options, soit enregistrer au préalable avant de lancer la macro soit définir un chemin de sauvegarde (soit en le sélectionnant soit un chemin fixe)

En fait, je pensais que c’était réalisable avec la macro. Avant je lançais la macro qui fixait tout puis sélectionnais manuellement « Arrêtes en mode image ombrée » et appuyais juste sur enregistrer sans sélection de dossier ou quoi que ce soit.

A moins que je ne me trompe, la macro ne peut pas savoir où enregistrer le fichier car le fichier ouvert n’a pas de chemin d’accès. Il n’y a pas d’enregistrement « automatique » via macro sans récupérer le chemin de quelque part.

Je ne comprend pas grand chose en macro mais comme on sélection la fonction « Arrêtes en mode image ombrée » (en cliquant dessus) je pensais qu’on pouvait faire de même avec enregistrer (sélectionner/appuyer dessus)

On peut émuler ça et ça ouvrira une fenêtre de sélection de dossier comme si l’on cliquait sur « Enregistrer »

je viens de tester la macro en enregistrant d’abords l’assemblage et la macro ferme l’assemblage quand elle fini son job. si on arrive à la faire fonctionner sans la fermeture de l’assemblage on pourra la laisser come ça; à force de vouloir tout simplifier; ça complique plus

Faut supprimer cette ligne à la fin de la partie qui est dans Sub Main

Sinon pour la fenêtre de sélection de dossier, pas un problème en soit j’ai déjà un code qui tourne avec si besoin de l’ajouter