I have a macro that fixes sets and subsets for imported files and I don't know enough about it to modify it as I would like. I would like her to activate "Stop in shaded image mode" and to save the stitching for me; Attached is the said macro for mordication if feasible
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
Here's a full macro (to add to yours) for "shaded edges" and recording:
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
I glued the end of the macro to mine but nothing happens when I launch it.
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
You can't have two macros named "Main()" in the same module. -option 1: rename one of the macros (the one I provided you), then call this macro with the command: Call TheMacroNameMacro just with the "end sub" of the first "macro"
Option number 2: Integrate the new macro into the old one: Move the variable declarations (DIMs...) of the new macro just below the "Option explicit" line (at the very top). delete duplicate declarations... if necessary. and paste the lines of the new macro before the "end sub" of the old one (by removing the Name of the new macro and its closing line "end sub"... Which should result in something like:
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
Note: If I sent this "standalone" macro it's so that you can test it before trying to integrate it into another... (you should always try before "buying").
Hello Sorry I don't know anything about vba but here is the code that works 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;
}
}
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
thanks for the macro but I'm not sure if it saves the sub-ASM and PRT because after launching it it fixes like the one I have and by validating the window that confirms that everything is fixed it closes the ASM and when I reopen it everything is empty even the sub-ASM.
I just understood, as the file is not saved there is no backup to make. Two options, either save beforehand before launching the macro or set a backup path (either by selecting it or a fixed path)
In fact, I thought it was feasible with the macro. Before, I'd launch the macro that fixed everything, then manually select "Stops in shaded image mode" and just hit save without folder selection or anything.
Unless I'm mistaken, the macro can't know where to save the file because the open file doesn't have a path. There is no " automatic " recording via macro without retrieving the path from somewhere.
I don't understand much in macro but since you select the "Stop in shaded image mode" function (by clicking on it) I thought you could do the same with save (select/press it)
I just tested the macro by first saving the assembly and the macro closes the assembly when it finishes its job. if we manage to make it work without closing the assembly we can leave it like this; by dint of wanting to simplify everything; it complicates more
Bravo 
