Wybieranie pliku do zaimportowania

[joris]

Witam

Nie mając dużej wiedzy na temat makr, szybko wyschłem na ten temat

W Solidworks 2022 zarejestrowałem następujące makro:

Dim swApp As Object

Przyciemnij część jako obiekt
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Ustaw swApp = Application.SldWorks

boolstatus = swApp.LoadFile2(" C:\temp\Nowy folder\test.stl ", " r ")
Ustaw część = swApp.ActiveDoc
Przyciemnij myModelView jako obiekt
Ustaw myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Zapisz jako
longstatus = Part.SaveAs3(" C:\temp\Nowy folder\test. SLDPRT ", 0, 0)
Koniec subwoofera

pozwala mi zaimportować plik STL i zapisać go jako część.
Mógłbym to zrobić ręcznie, ale to dopiero początek mojego pragnienia automatyzacji

W 1 kroku chciałbym mieć możliwość wyboru pliku STL, który chcę zaimportować.
Nie mogę znaleźć przykładu, który by mi pomógł, a przeszedłem przez sztuczną inteligencję, która rozwiązuje mój problem, dodając błędy we wszystkich kierunkach.

[Maclane]

Witam;
Oto przykład, jak wywołać przeglądarkę plików systemu 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

W tym przykładzie celowo wywołuję odniesienie do programu Excel, aby uniknąć problemów ze zgodnością z interfejsem API Solidworks.
=> … W edytorze VBA SolidWorks przejdź do Narzędzia > Odniesienia...
Należy dodać odniesienie:  Biblioteka obiektów pakietu Microsoft Office XX.0 " (gdzie XX zależy od używanej wersji pakietu Office).
W tym przykładzie zmienna " MyWay " będzie odpowiednikiem Twojej linii:

@joris

boolstatus = swApp.LoadFile2("C:\temp\Nowy folder\test.stl", "r")

…

Uwaga osobista: aby rozpocząć w makrze, nigdy nie wahaj się użyć polecenia " Debug.print "
na przykład: Debug.print MyPath
poda wartość zmiennej " MyPath " w oknie Uruchom edytora VBA.
Drugą operacją pozwalającą zrozumieć kod jest tryb krok po kroku (F8), powiązany z oknem " Zmienna lokalna " i oknem " Wykonanie " edytora ułatwi odczytanie i zrozumienie kodu:
Wykonanie kodu w trybie krokowym będzie wykonywane wiersz po wierszu (przy każdym F8)
a dane " pobrane" przez makro będą widoczne w oknie " Zmienne lokalne "

[Cyril_f]

@Maclane

W tym przykładzie celowo wywołuję odniesienie do programu Excel, aby uniknąć problemów ze zgodnością z interfejsem API Solidworks.

Witam
Jest funkcja FolderBrowse (o ile dobrze pamiętam z kodu udostępnionego na tym forum lub starym), której używam i która doskonale współpracuje z oprogramowaniem bez użycia funkcji Excela.

[Maclane]

@Cyril_f funkcja " FolderBrowse " nie jest specyficzna dla korzystania z PDM?
https://help.solidworks.com/2017/English/api/epdmapi/EPDM.Interop.epdm~EPDM.Interop.epdm.IEdmVault11~BrowseForFolder2.html

w przeciwnym razie mały samouczek:

VBA Userforms - Przeglądanie plików SOLIDWORKS

[Cyril_f]

Nie, jest to kodowany moduł, który korzysta z funkcji systemu Windows

[Maclane]

Kilka przykładów forum z FolderBrowse jako słowem kluczowym:

Jak dodać okno przeglądania w

Witam,  posiadam makro które linkuję, szukam sposobu na zintegrowanie w nim FolderBrowse aby móc wybrać folder, w którym będzie się zapisywać    dxf.swp

Makro — ścieżka folderu docelowego

Dziękuję bardzo, to jest dokładnie to. Czy istnieje sposób, aby pasek adresu systemu Windows znajdował się w oknie, aby ułatwić kopiowanie ścieżek docelowych?

Okno dialogowe SW VBA wybierające folder

Musisz spojrzeć na ostatni post poprzedniego linku, który odnosi się do linku i postu @liryc https://www.lynkoa.com/forum/solidworks/bouton-parcourir-macro-vba Mam nadzieję, że tym razem jest to właściwe okno dialogowe: Dla kodu w 1. module: Dim swApp jako SldWorks.SldWorks Dim FileName As Ciąg Przyciemnij filtr jako ciąg Dim fileConfig As String Dim fileDispName As Ciąg Przyciemnij fileOptions tak długo 'Sub main() 'Ustaw swApp = Application.SldWorks "F...

Makro do masowej transformacji. SLDPRT z blachy w rozłożeniu w . DWG lub . Blacha DXF

Witam, Ostateczna wersja pojawi się wkrótce, jeśli nie będzie więcej modyfikacji... Pozdrowienia

[Cyril_f]

To jest kod, którego używam:

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]

Dziękuję za odpowiedzi.
Staram się spojrzeć na to przed wakacjami i przekazać Wam informację zwrotną.
w przeciwnym razie trochę poczeka

[joris]

Cóż, po różnych testach dochodzę do wniosku, że jest to o wiele bardziej złożony temat, niż myślałem, a moja wiedza na ten temat jest bliska zeru.
Nie będę w stanie prawidłowo iść naprzód ze wszystkimi moimi problemami.

W każdym razie dziękuję wszystkim za opinie

[Cyril_f]

Witam
Z kodu w oryginalnej wiadomości:

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: Pominąłem, funkcja którą podałem w drugiej wiadomości pozwala tylko wybrać folder, a nie konkretny plik

[joris]

Dziękuję bardzo.