Diagnostic import on several parts of an assembly

3D Design Assembly
1

Hello

I imported an IGES from an assembly. Solidworks creates all the parts for me but for each of them I have to carry out an import diagnosis to repair the faces.

Is there a way to fix all the parts without opening them 1 by 1?

2

No

3

Hello

Not to my knowledge, but with the help of a macro it is certainly possible. 

Have a nice day

1 Like
4

Well yes, finally I did a macro, it took me 5min. No need to look any further, although it would have been nice to have a dedicated function:)

1 Like
5

Hello

Can you share it?
Even if it's succinct, it can be practical.

Thank you

6

I'm not a VBA pro, I just tinkered but it works. I put a BrowseFolder as well.

 

 

Option Explicit

Dim swApp        As SldWorks.SldWorks
Dim swModel      As SldWorks.ModelDoc
Dim sFileName    As String
Dim FileName    As String
Dim Path         As String
Dim newPath         As String
Dim swLayerMgr   As SldWorks.LayerMgr
Dim swLayer      As SldWorks.Layer
Dim nErrors      As Long
Dim nWarnings    As Long

Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

Dim Folder As Object
Dim F As Folder
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")

Set F = ShellApp.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    If F = "Desktop" Then
        BrowseFolder = About("USERPROFILE") & "\Desktop"
    Else
        BrowseFolder = F.Items.Item.Path
    End If
End If

End Function

Sub main()

Set swApp = Application.SldWorks

' Choosing the source folder
Path = BrowseFolder(Caption:="Select source folder")

    If Path = "" Then
    'MsgBox "Select Source Folder"
    End
    Else
    Path = Path & "\"
    End If

sFileName = Dir(Path & "*.sldprt")
    
Do Until sFileName = ""

Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swModel = swApp.ActiveDoc

longstatus = swModel.ImportDiagnosis(True, False, True, 0)

Dim swErrors As Long
Dim swWarnings As Long
boolstatus = swModel.Save3(1, swErrors, swWarnings)

swApp.CloseDoc swModel.GetTitle
Set swModel = Nothing


sFileName = Dir

Loop

End Sub
 

2 Likes