Makro-Modifikation "Fix-Sets und Subsets"

ac_cobra_427 · 26. Januar 2024 um 07:45

Hallo Kolleginnen und Kollegen,

Ich habe ein Makro, das Sätze und Teilmengen für importierte Dateien korrigiert, und ich weiß nicht genug darüber, um es nach Belieben zu ändern. Ich möchte, dass sie "Stopp im schattierten Bildmodus" aktiviert und das Stitching für mich speichert; Beigefügt ist das besagte Makro zur Beschädigung, falls machbar

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. Januar 2024 um 07:53

Hallo;

Hier ist ein vollständiges Makro (zum Hinzufügen zu Ihrem Makro) für "schattierte Kanten" und Aufnahme:

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

Herzliche Grüße.

ac_cobra_427 · 26. Januar 2024 um 10:18

Hallo @Maclane ,

Ich habe das Ende des Makros an meines geklebt, aber beim Starten passiert nichts.

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. Januar 2024 um 12:46

Hallo;

Sie können nicht zwei Makros mit dem Namen "Main()" im selben Modul haben.
-Option 1: Benennen Sie eines der Makros um (das, das ich Ihnen zur Verfügung gestellt habe), dann rufen Sie dieses Makro mit dem Befehl auf:
Aufrufen von TheMacroNameMacro
nur mit dem "End Sub" des ersten "Makros"

Option Nummer 2:
Integrieren Sie das neue Makro in das alte:
Verschieben Sie die Variablendeklarationen (DIMs...) des neuen Makros direkt unter die Zeile "Option explizit" (ganz oben).
Doppelte Deklarationen löschen... gegebenenfalls.
und fügen Sie die Zeilen des neuen Makros vor dem "End Sub" des alten Makros ein (indem Sie den Namen des neuen Makros und seine abschließende Zeile "End Sub" entfernen...
Was zu etwas führen sollte wie:

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

Hinweis: Wenn ich dieses "eigenständige" Makro gesendet habe, dann so, dass Sie es testen können, bevor Sie versuchen, es in ein anderes zu integrieren... (Sie sollten es immer ausprobieren, bevor Sie "kaufen").

Herzliche Grüße.

ac_cobra_427 · 26. Januar 2024 um 14:57

Ich habe gerade das Makro kopiert und eingefügt, aber es wird nichts gestartet. dsl Ich bin eine echte Quiche in VBA

Konti · 29. Januar 2024 um 14:31

Hallo
Tut mir leid, ich weiß nichts über vba, aber hier ist der Code, der in C funktioniert#

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;
    }
}

Herzliche Grüße

Cyril.f · 30. Januar 2024 um 06:17

Hallo

Hier ist der geänderte und funktionierende Code auf 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. Januar 2024 um 07:19

Bravo @Cyril.f ... Wir können auf Sie zählen.
Ich schäme mich, wenn ich mir jetzt meinen vorherigen Beitrag anschaue... Ich hatte dieses Makro mit meinen beiden linken Füßen neu geschrieben...

Herzliche Grüße.

Cyril.f · 30. Januar 2024 um 07:27

Das passiert. Ich habe auch ein Makro in Produktion genommen, bei dem ich vergessen hatte, ein Stück Testcode zu löschen, so dass für die Benutzer alles fehlerhaft war.

ac_cobra_427 · 30. Januar 2024 um 08:15

Hallo @Cyril.f ,

Danke für das Makro, aber ich bin mir nicht sicher, ob es das Sub-ASM und PRT speichert, weil es nach dem Start wie das von mir behoben wird, und durch die Validierung des Fensters, das bestätigt, dass alles behoben ist, das ASM geschlossen wird, und wenn ich es wieder öffne, ist alles leer, sogar das Sub-ASM.

Cyril.f · 30. Januar 2024 um 08:21

Vielleicht ein bisschen schnell getestet. Ich habe keinen Export zur Hand, um ihn zu überprüfen, kann ich einen teilen?

ac_cobra_427 · 30. Januar 2024 um 09:04

@Cyril.f,

an ein getestetes ASM angehängt

MEHRWERTSTEUER. SCHRITT (3,2 MB)

Cyril.f · 30. Januar 2024 um 09:16

Ich habe gerade verstanden, da die Datei nicht gespeichert wird, muss keine Sicherung erstellt werden.
Zwei Optionen: Entweder vorher speichern, bevor das Makro gestartet wird, oder einen Backup-Pfad festlegen (entweder durch Auswahl des Makros oder durch einen festen Pfad)

ac_cobra_427 · 30. Januar 2024 um 09:24

Tatsächlich dachte ich, dass es mit dem Makro machbar ist. Früher habe ich das Makro gestartet, das alles behoben hat, dann manuell "Stoppt im schattierten Bildmodus" ausgewählt und einfach auf Speichern ohne Ordnerauswahl oder ähnliches geklickt.

Cyril.f · 30. Januar 2024 um 09:36

Wenn ich mich nicht irre, kann das Makro nicht wissen, wo die Datei gespeichert werden soll, da die geöffnete Datei keinen Pfad hat. Es gibt keine " automatische " Aufzeichnung per Makro, ohne den Pfad von irgendwoher abzurufen.

ac_cobra_427 · 30. Januar 2024 um 09:59

Ich verstehe nicht viel im Makro, aber da Sie die Funktion "Stopp im schattierten Bildmodus" auswählen (indem Sie darauf klicken), dachte ich, Sie könnten dasselbe mit Speichern tun (auswählen/drücken)

Cyril.f · 30. Januar 2024 um 10:00

Wir können dies emulieren und es öffnet sich ein Ordnerauswahlfenster, als ob wir auf " Speichern " klicken würden

ac_cobra_427 · 30. Januar 2024 um 11:41

Ich habe gerade das Makro getestet, indem ich zuerst die Assembly gespeichert habe, und das Makro schließt die Assembly, wenn es seine Arbeit beendet hat. Wenn wir es schaffen, dass es funktioniert, ohne die Baugruppe zu schließen, können wir es so lassen; indem sie alles vereinfachen wollen; Es verkompliziert mehr

Cyril.f · 30. Januar 2024 um 11:42

Sie müssen diese Zeile am Ende des Spiels löschen, das sich in Sub Main befindet

Cyril.f · 30. Januar 2024 um 11:43

Ansonsten für das Ordnerauswahlfenster, an sich kein Problem, ich habe bereits einen Code, der damit ausgeführt wird, wenn Sie ihn hinzufügen müssen