Diagnostique d'import sur plusieurs pièces d'un assemblage

3D Design Assembly
1

Bonjour,

j'ai importé un IGES d'un assemblage. Solidworks me crée toutes les pièces mais pour chacune d'elles je dois effectuer un diagnostique d'import pour réparer les faces.

Y a-t-il un moyen de réparer toutes les pièces sans les ouvrir 1 par 1 ?

2

Non

3

bonjour,

Pas à ma connaissance, mais à l'aide d'une macro c'est certainement possible. 

bonne journée

1 « J'aime »
4

bon oui, finalement j'ai fait une macro, ca m'a pris 5min. Inutile de chercher plus loin, même s'il aurait été sympa d'avoirn une fonction dédiée :)

1 « J'aime »
5

Bonjour,

Pouvez-vous la partager ?
Même si c'est succinct, ça peut être pratique.

Merci

6

Je ne suis pas un pro de VBA, j'ai juste bricolé mais ca fonctionne. J'ai mis un BrowseFolder également.

 

 

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 = Environ("USERPROFILE") & "\Desktop"
    Else
        BrowseFolder = F.Items.Item.Path
    End If
End If

End Function

Sub main()

Set swApp = Application.SldWorks

' Choix du dossier source
Path = BrowseFolder(Caption:="Sélectionner dossier source")

    If Path = "" Then
    'MsgBox "Sélectionner le dossier source"
    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 « J'aime »