Choix fichier à importer

[joris]

Bonjour,

n’ayant pas grande connaissance des macros, je sèche rapidement sur le sujet

j’ai enregistré la macro suivante sous solidworks 2022:

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

boolstatus = swApp.LoadFile2(« C:\temp\Nouveau dossier\test.stl », « r »)
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

’ Save As
longstatus = Part.SaveAs3(« C:\temp\Nouveau dossier\test.SLDPRT », 0, 0)
End Sub

elle me permet d’importer un STL et de l’enregistrer en part.
je pourrai le faire manuellement mais c’est que le début de mon souhait d’automatisation

Dans un 1er temps, j’aimerai avoir la possibilité de choisir le fichier STL que je souhaite importer.
je ne trouve pas d’exemple pour m’aider, et je suis passé par l’IA qui me solutionne ma problématique en me rajoutant des erreurs dans tous les sens.

[Maclane]

Bonjour;
Voici un exemple d’appel du navigateur de fichier Windows:

Dim MonChemin As String

    If MsgBox("Choisissez un fichier à ouvrir", vbOKCancel, "Nouveau Fichier") = vbOK Then
        With objExcelObject.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "XXXXXXXX" 'Choisir l'emplacement de départ du chemin de recherche
            .AllowMultiSelect = False ' on choisit un seul fichier
            If .Show Then             ' on vérifie que l'utilisateur a bien choisi un fichier et n'a pas appuyé sur "annuler"
                MonChemin = .SelectedItems(1)
            Else
                MsgBox "Aucune fichier sélectionné"
                 End If
        End With
    End If

Dans cet exemple j’ appel volontairement la référence à Excel pour éviter des problèmes de compatibilité avec l’API de Solidworks.
=> …Dans l’éditeur VBA de SolidWorks, allez dans Outils > Références…
Il faudra ajouter la Référence : .« Microsoft Office XX.0 Object Library » (où XX dépend de votre version d’Office).
Dans cet exemple c’est la variable « MonChemin » qui sera l’équivalent de ta ligne:

@joris

boolstatus = swApp.LoadFile2(« C:\temp\Nouveau dossier\test.stl », « r »)

…

Note perso: pour débuter en macro, ne jamais hésiter à utiliser la commande « Debug.print »
par exemple : Debug.print MonChemin
donnera la valeur de la variable « MonChemin » dans la fenêtre Exécution de l’editeur VBA.
La seconde opération pour comprendre le code est le mode pas-a-pas (F8), associé à la fenêtre « Variable locale » et à la fenêtre « Execution » de l’éditeur facilitera la lecture et la compréhension du code:
L’éxécution du code en mode pas à pas se fera ligne par ligne (à chaque F8)
et les données « récupérée » par la macro seront visibles dans la fenêtre « Variables locales »

[Cyril_f]

@Maclane

Dans cet exemple j’ appel volontairement la référence à Excel pour éviter des problèmes de compatibilité avec l’API de Solidworks.

Bonjour,
Il y a une fonction FolderBrowse (si je me souviens bien issue d’un code partagé sur ce forum ou l’ancien) que j’utilise et qui fonctionne parfaitement avec SW sans faire appel aux fonctions Excel.

[Maclane]

@Cyril_f la fonction « FolderBrowse » n’est-elle pas spécifique à l’utilisation d’un PDM ?
https://help.solidworks.com/2017/English/api/epdmapi/EPDM.Interop.epdm~EPDM.Interop.epdm.IEdmVault11~BrowseForFolder2.html

sinon un petit tuto :

VBA Userforms - Browse SOLIDWORKS file(s)

[Cyril_f]

Non, c’est un module codé qui fait appel aux fonctions Windows

[Maclane]

Quelques exemples du forum avec FolderBrowse en mot clef :

Comment rajouter une fenêtre parcourir sur une macro

Bonjour ,  j'ai une macro que je met en lien , je cherche comment intégrer FolderBrowse dedans pour pouvoir sélectionner le dossier dans lequelle il va enregistrer    dxf.swp

Macro - chemin dossier destination

Merci beaucoup, c'est exactement cela. Y'a t'il moyen d'avoir la barre d'adresse windows dans la fenetre afin de faciliter la copie des chemins de destination ?

SW VBA boite dialogue sélection dossier

Il faut regarder le dernier post du lien précédent qui renvoit vers un lien et un post de @liryc https://www.lynkoa.com/forum/solidworks/bouton-parcourir-macro-vba En espérant que ce soit la bonne boite de dialogue cette fois: Pour le code dans le 1er module: Dim swApp As SldWorks.SldWorks Dim FileName As String Dim Filter As String Dim fileConfig As String Dim fileDispName As String Dim fileOptions As Long 'Sub main() 'Set swApp = Application.SldWorks 'F…

Macro pour transformer en masse .SLDPRT de tolerie en déplié au format .DWG ou .DXF

Bonjour, La version finale à venir sous peu si pas plus de modif... Cordialement,

[Cyril_f]

C’est ce code que j’utilise:

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long


Public Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)

Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const CSIDL_DRIVES As Long = &H11
Private Const WM_USER As Long = &H400
Private Const MAX_PATH As Long = 260
'// message from browser
Private Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_VALIDATEFAILEDA As Long = 3 '// lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW As Long = 4 '// lParam:wzPath ret:1(cont),0(EndDialog)
Private Const BFFM_IUNKNOWN As Long = 5 '// provides IUnknown to client. lParam: IUnknown*
'// messages to browser
Private Const BFFM_SETSTATUSTEXTA As Long = WM_USER + 100
Private Const BFFM_ENABLEOK As Long = WM_USER + 101
Private Const BFFM_SETSELECTIONA As Long = WM_USER + 102
Private Const BFFM_SETSELECTIONW As Long = WM_USER + 103
Private Const BFFM_SETSTATUSTEXTW As Long = WM_USER + 104
Private Const BFFM_SETOKTEXT As Long = WM_USER + 105 '// Unicode only
Private Const BFFM_SETEXPANDED As Long = WM_USER + 106 '// Unicode only

Public Type BrowseInfo
hWndOwner As LongPtr
pIDLRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As LongPtr
lParam As LongPtr
iImage As Long
End Type

'====== Folder Browser for 64 bit VBA 7 ========
Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String
Dim ReturnPath As String

Dim b(MAX_PATH) As Byte
Dim pItem As Long
Dim sFullPath As String
Dim bi As BrowseInfo
Dim ppidl As Long

sInitFolder = CorrectPath(sInitFolder)

' Note VBA windows and dialogs do not have an hWnd property.
bi.hWndOwner = 0 'Windows Main Screen handle.

' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl

bi.pIDLRoot = 0 'ppidl


bi.pszDisplayName = VarPtr(b(0))
bi.lpszTitle = sDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS
If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
bi.lParam = StrPtr(sInitFolder)
pItem = SHBrowseForFolder(bi)

If pItem Then ' Succeeded
sFullPath = Space$(MAX_PATH)
If SHGetPathFromIDList(pItem, sFullPath) Then
ReturnPath = left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
CoTaskMemFree pItem
End If
End If

If ReturnPath <> "" Then
If right$(ReturnPath, 1) <> "\" Then
ReturnPath = ReturnPath & "\"
End If
End If

FolderBrowse = ReturnPath

End Function
' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Private Function BFFCallback(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr, ByVal lParam As LongPtr, ByVal sData As String) As LongPtr
If uMsg = BFFM_INITIALIZED Then
SendMessageA hWnd, BFFM_SETSELECTIONA, True, ByVal sData
End If
End Function
Private Function PtrToFunction(ByVal lFcnPtr As LongPtr) As LongPtr
PtrToFunction = lFcnPtr
End Function
Private Function CorrectPath(ByVal sPath As String) As String
If right$(sPath, 1) = "\" Then
If Len(sPath) > 3 Then sPath = left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
Else
If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root
End If
CorrectPath = sPath
End Function

Public Function FolderExists(ByVal sFolderName As String) As Boolean
Dim att As Long
On Error Resume Next
att = GetAttr(sFolderName)
If Err.Number = 0 Then
FolderExists = True
Else
Err.Clear
FolderExists = False
End If
On Error GoTo 0
End Function

[joris]

merci pour vos réponses.
je tache de regarder ca avant mes vacances et de vous faire un retour.
sinon ca attendra un peu

[joris]

Bon, après différents tests, j’en conclu que c’est un sujet beaucoup plus complexe que je le pensais, et que mes connaissances sont proches de zéro sur le sujet.
je n’arriverai pas à avancer correctement avec l’ensemble de ma problématique.

En tout cas, merci à tous pour vos retours

[Cyril_f]

Bonjour,
A partir du code sur le message d’origine:

Dim Part            As SldWorks.ModelDoc2
Dim FileName        As String
Dim Filter          As String
Dim fileConfig      As String
Dim fileDispName    As String
Dim fileOptions     As Long
Dim swApp           As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Filter = "SolidWorks Files (*.stl)|*.stl"
FileName = swApp.GetOpenFileName("File to Attach", "", Filter, fileOptions, fileConfig, fileDispName)
If FileName = "" Then
    Exit Sub
Else
    boolstatus = swApp.LoadFile2(FileName, "r")
    Set Part = swApp.ActiveDoc
    Dim myModelView As Object
    Set myModelView = Part.ActiveView
    myModelView.FrameState = swWindowState_e.swWindowMaximized
    ' Save As
    longstatus = Part.SaveAs3("C:\temp\Nouveau dossier\test.SLDPRT", 0, 0)
End If
End Sub

Edit: J’ai zappé, la fonction que j’ai donné dans l’autre message ne permet de sélectionner qu’un dossier, pas un fichier en particulier

[joris]

merci beaucoup.