Macro modificatie "fix sets en subsets"

ac_cobra_427 · 26 januari 2024 om 07:45

Hallo collega's,

Ik heb een macro die sets en subsets voor geïmporteerde bestanden repareert en ik weet er niet genoeg van om het te wijzigen zoals ik zou willen. Ik zou graag willen dat ze "Stop in gearceerde beeldmodus" activeert en het stiksel voor mij opslaat; Bijgevoegd is de genoemde macro voor mordicatie indien mogelijk

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

Maclane · 26 januari 2024 om 07:53

Hallo;

Hier is een volledige macro (om toe te voegen aan de jouwe) voor "gearceerde randen" en opname:

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

Vriendelijke groeten.

ac_cobra_427 · 26 januari 2024 om 10:18

Hallo @Maclane ,

Ik heb het uiteinde van de macro aan de mijne gelijmd, maar er gebeurt niets als ik hem start.

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

Maclane · 26 januari 2024 om 12:46

Hallo;

U kunt niet twee macro's met de naam "Main()" in dezelfde module hebben.
-optie 1: hernoem een van de macro's (degene die ik je heb gegeven), roep dan deze macro aan met het commando:
Roep TheMacroNameMacro aan
alleen met de "end sub" van de eerste "macro"

Optie nummer 2:
Integreer de nieuwe macro in de oude:
Verplaats de variabeledeclaraties (DIM's...) van de nieuwe macro net onder de regel "Optie expliciet" (helemaal bovenaan).
Dubbele aangiften verwijderen... desnoods.
en plak de regels van de nieuwe macro voor de "end sub" van de oude (door de naam van de nieuwe macro en de slotregel "end sub" te verwijderen...
Wat zou moeten resulteren in iets als:

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

Opmerking: Als ik deze "standalone" macro heb verzonden, is dat zodat u deze kunt testen voordat u deze probeert te integreren in een andere... (u moet het altijd proberen voordat u "koopt").

Vriendelijke groeten.

ac_cobra_427 · 26 januari 2024 om 14:57

Ik heb zojuist de macro gekopieerd en geplakt, maar er wordt niets gestart; dsl Ik ben een echte quiche in VBA

Konti · 29 januari 2024 om 14:31

Hallo
Sorry dat ik niets weet over vba, maar hier is de code die werkt in 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;
    }
}

Vriendelijke groeten

Cyril_f · 30 januari 2024 om 06:17

Hallo

Hier is de gewijzigde en werkende code op 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

Maclane · 30 januari 2024 om 07:19

Bravo @Cyril_f ... We kunnen op je rekenen.
Ik schaam me als ik nu naar mijn vorige post kijk... Ik had deze macro herschreven met mijn twee linkervoeten...

Vriendelijke groeten.

Cyril_f · 30 januari 2024 om 07:27

Het gebeurt. Ik heb ook een macro in productie gezet waarbij ik was vergeten een stukje testcode te verwijderen, dus alles was fout voor de gebruikers.

ac_cobra_427 · 30 januari 2024 om 08:15

Hallo @Cyril_f ,

bedankt voor de macro, maar ik weet niet zeker of het de sub-ASM en PRT opslaat, want na het starten ervan repareert het zoals degene die ik heb en door het valideren van het venster dat bevestigt dat alles is opgelost, sluit het de ASM en wanneer ik het opnieuw open, is alles leeg, zelfs de sub-ASM.

Cyril_f · 30 januari 2024 om 08:21

Misschien een beetje snel getest. Ik heb geen export bij de hand om te controleren, kan ik er een delen?

ac_cobra_427 · 30 januari 2024 om 09:04

@Cyril_f,

bijgevoegd een geteste ASM

BTW. STAP (3.2 MB)

Cyril_f · 30 januari 2024 om 09:16

Ik begreep het net, aangezien het bestand niet is opgeslagen, hoeft er geen back-up te worden gemaakt.
Twee opties: vooraf opslaan voordat de macro wordt gestart of een back-uppad instellen (door het te selecteren of een vast pad)

ac_cobra_427 · 30 januari 2024 om 09:24

Sterker nog, ik dacht dat het haalbaar was met de macro. Vroeger zou ik de macro starten die alles oploste, vervolgens handmatig "Stopt in gearceerde afbeeldingsmodus" selecteren en gewoon op opslaan drukken zonder mapselectie of iets dergelijks.

Cyril_f · 30 januari 2024 om 09:36

Tenzij ik me vergis, kan de macro niet weten waar het bestand moet worden opgeslagen omdat het geopende bestand geen pad heeft. Er is geen " automatische " opname via macro zonder het pad ergens vandaan te halen.

ac_cobra_427 · 30 januari 2024 om 09:59

Ik begrijp niet veel in macro, maar aangezien je de functie "Stop in gearceerde afbeeldingsmodus" selecteert (door erop te klikken), dacht ik dat je hetzelfde kon doen met opslaan (selecteren/drukken)

Cyril_f · 30 januari 2024 om 10:00

We kunnen dit emuleren en het zal een mapselectievenster openen alsof we op " Opslaan "

ac_cobra_427 · 30 januari 2024 om 11:41

Ik heb zojuist de macro getest door eerst de assemblage op te slaan en de macro sluit de assemblage wanneer deze zijn werk voltooit. Als het ons lukt om het te laten werken zonder de assemblage te sluiten, kunnen we het zo laten; door alles te willen vereenvoudigen; het maakt het nog ingewikkelder

Cyril_f · 30 januari 2024 om 11:42

Je moet deze regel verwijderen aan het einde van het spel dat zich in Sub Main bevindt

Cyril_f · 30 januari 2024 om 11:43

Anders voor het mapselectievenster, op zich geen probleem, ik heb al een code die ermee wordt uitgevoerd als dat nodig is om deze toe te voegen