Modyfikacja makr "zestawy i podzbiory poprawek"

ac_cobra_427 · 26 Styczeń 2024 07:45

Witam Koleżanki i Koledzy,

Mam makro, które naprawia zestawy i podzbiory dla importowanych plików i nie wiem o nim wystarczająco dużo, aby zmodyfikować je tak, jak bym chciał. Chciałbym, aby aktywowała opcję "Zatrzymaj w trybie cieniowanego obrazu" i zapisała dla mnie ściegi; W załączeniu znajduje się wspomniane makro do umartwienia, jeśli jest to wykonalne

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 Styczeń 2024 07:53

Witam;

Oto pełne makro (które możesz dodać do swojego) dla "cieniowanych krawędzi" i nagrywania:

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

Pozdrowienia.

ac_cobra_427 · 26 Styczeń 2024 10:18

Witaj @Maclane ,

Przykleiłem koniec makra do mojego, ale nic się nie dzieje po uruchomieniu.

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 Styczeń 2024 12:46

Witam;

Nie można mieć dwóch makr o nazwie "Main()" w tym samym module.
-opcja 1: zmień nazwę jednego z makr (tego, które ci dostarczyłem), a następnie wywołaj to makro za pomocą polecenia:
Wywołaj nazwęMakra
tylko z "end sub" pierwszego "makra"

Opcja nr 2:
Zintegruj nowe makro ze starym:
Przenieś deklaracje zmiennych (DIMs...) nowego makra tuż poniżej wiersza "Opcja jawna" (na samej górze).
Usuń zduplikowane deklaracje... w razie potrzeby.
i wklej wiersze nowego makra przed "end sub" starego (usuwając nazwę nowego makra i jego linię zamykającą "end sub"...
Co powinno skutkować czymś takim:

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

Uwaga: Jeśli wysłałem to "samodzielne" makro, to po to, abyś mógł je przetestować przed próbą zintegrowania go z innym... (zawsze powinieneś spróbować przed "zakupem").

Pozdrowienia.

ac_cobra_427 · 26 Styczeń 2024 14:57

Właśnie skopiowałem i wkleiłem makro, ale nic się nie uruchamia; dsl jestem prawdziwym quiche w VBA

Konti · 29 Styczeń 2024 14:31

Witam
Przepraszam, nie wiem nic o vba, ale oto kod, który działa w 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;
    }
}

Pozdrowienia

Cyril_f · 30 Styczeń 2024 06:17

Witam

Oto zmodyfikowany i działający kod na 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 Styczeń 2024 07:19

Brawo @Cyril_f ... Możemy na Was liczyć.
Wstyd mi teraz patrzeć na mój poprzedni post... Napisałem to makro od nowa dwiema lewymi stopami...

Pozdrowienia.

Cyril_f · 30 Styczeń 2024 07:27

Zdarza się. Uruchomiłem również makro, w którym zapomniałem usunąć fragment kodu testowego, więc wszystko było błędne dla użytkowników.

ac_cobra_427 · 30 Styczeń 2024 08:15

Witaj @Cyril_f ,

dzięki za makro, ale nie jestem pewien, czy zapisuje sub-ASM i PRT, ponieważ po uruchomieniu naprawia się jak ten, który mam, a sprawdzając okno, które potwierdza, że wszystko zostało naprawione, zamyka ASM, a kiedy ponownie je otwieram, wszystko jest puste, nawet sub-ASM.

Cyril_f · 30 Styczeń 2024 08:21

Może przetestowane trochę szybko. Nie mam pod ręką eksportu do sprawdzenia, czy mogę go udostępnić?

ac_cobra_427 · 30 Styczeń 2024 09:04

@Cyril_f,

dołączony przetestowany ASM

VAT. KROK ( 3.2 MB)

Cyril_f · 30 Styczeń 2024 09:16

Po prostu zrozumiałem, ponieważ plik nie jest zapisywany, nie ma kopii zapasowej do wykonania.
Dwie opcje: albo zapisz wcześniej przed uruchomieniem makra, albo ustaw ścieżkę kopii zapasowej (wybierając ją lub stałą ścieżkę)

ac_cobra_427 · 30 Styczeń 2024 09:24

W rzeczywistości myślałem, że jest to wykonalne z makro. Wcześniej uruchamiałem makro, które wszystko naprawiało, a następnie ręcznie wybierałem "Zatrzymuje się w trybie cieniowanego obrazu" i po prostu klikałem zapisz bez wyboru folderu lub czegokolwiek.

Cyril_f · 30 Styczeń 2024 09:36

O ile się nie mylę, makro nie wie, gdzie zapisać plik, ponieważ otwarty plik nie ma ścieżki. Nie ma " automatycznego " nagrywania za pomocą makra bez pobrania skądś ścieżki.

ac_cobra_427 · 30 Styczeń 2024 09:59

Nie rozumiem zbyt wiele w makro, ale skoro wybierasz funkcję "Zatrzymaj w trybie cieniowanego obrazu" (klikając na nią), pomyślałem, że możesz zrobić to samo z zapisem (wybierz / naciśnij go)

Cyril_f · 30 Styczeń 2024 10:00

Możemy to emulować i otworzy się okno wyboru folderu, tak jakbyśmy klikali " Zapisz "

ac_cobra_427 · 30 Styczeń 2024 11:41

Właśnie przetestowałem makro, najpierw zapisując zestaw, a makro zamyka zestaw po zakończeniu pracy. Jeśli uda nam się sprawić, by działał bez zamykania zespołu, możemy go tak zostawić; ze względu na chęć uproszczenia wszystkiego; To bardziej komplikuje

Cyril_f · 30 Styczeń 2024 11:42

Musisz usunąć tę linię na końcu gry, która znajduje się w Sub Main

Cyril_f · 30 Styczeń 2024 11:43

W przeciwnym razie dla okna wyboru folderu nie jest to problem sam w sobie, mam już kod, który działa z nim, jeśli zajdzie potrzeba dodania go