Een bestand kiezen om te importeren

[joris]

Hallo

Omdat ik niet veel kennis van macro's heb, droog ik snel op in het onderwerp

Ik heb de volgende macro opgenomen in Solidworks 2022:

Dim swApp als object

Dim onderdeel als object
Dim boolstatus Als Booleaans
Dim longstatus Zo lang, longwarnings Zo lang

Sub main()

Stel swApp = Application.SldWorks in

boolstatus = swApp.LoadFile2("C :\temp\Nieuwe map\test.stl ", " r ")
Set Part = swApp.ActiveDoc
Dim myModelView als object
Stel myModelView = Part.ActiveView in
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Opslaan als
longstatus = Deel.SaveAs3(" C:\temp\Nieuwe map\test. SLDPRT ", 0, 0)
Einde sub

het stelt me in staat om een STL te importeren en op te slaan als een onderdeel.
Ik zou het handmatig kunnen doen, maar dat is nog maar het begin van mijn verlangen naar automatisering

In een 1e stap zou ik graag de mogelijkheid willen hebben om het STL-bestand te kiezen dat ik wil importeren.
Ik kan geen voorbeeld vinden om me te helpen, en ik heb AI doorlopen die mijn probleem oplost door fouten in alle richtingen toe te voegen.

[Maclane]

Hallo;
Hier volgt een voorbeeld van hoe u de Windows-bestandsbrowser aanroept:

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

In dit voorbeeld roep ik met opzet de verwijzing naar Excel aan om compatibiliteitsproblemen met de Solidworks API te voorkomen.
=> … Ga in de SolidWorks VBA-editor naar Tools > References...
De verwijzing moet worden toegevoegd:  Microsoft Office XX.0 Object Library " (waarbij XX afhankelijk is van uw versie van Office).
In dit voorbeeld zal de variabele " MyWay " het equivalent zijn van uw regel:

@joris

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

…

Persoonlijke opmerking: om in macro te beginnen, aarzel nooit om het commando " Debug.print " te gebruiken
bijvoorbeeld: Debug.print MyPath
geeft de waarde van de variabele " MyPath " in het venster Uitvoeren van de VBA Editor.
De tweede bewerking om de code te begrijpen is de stap-voor-stap modus (F8), gekoppeld aan het venster " Lokale variabele" en het venster " Uitvoering " van de editor maakt het gemakkelijker om de code te lezen en te begrijpen:
De uitvoering van de code in stapmodus gebeurt regel voor regel (bij elke F8)
en de gegevens die door de macro worden " opgehaald" zullen zichtbaar zijn in het venster " Lokale variabelen"

[Cyril_f]

@Maclane

In dit voorbeeld roep ik met opzet de verwijzing naar Excel aan om compatibiliteitsproblemen met de Solidworks API te voorkomen.

Hallo
Er is een FolderBrowse-functie (als ik het me goed herinner van een code die op dit forum is gedeeld of de oude) die ik gebruik en die perfect werkt met SW zonder Excel-functies te gebruiken.

[Maclane]

@Cyril_f is de functie " FolderBrowse " niet specifiek voor het gebruik van een PDM?
https://help.solidworks.com/2017/English/api/epdmapi/EPDM.Interop.epdm~EPDM.Interop.epdm.IEdmVault11~BrowseForFolder2.html

Anders een kleine tutorial:

VBA Userforms - Blader door SOLIDWORKS-bestanden

[Cyril_f]

Nee, het is een gecodeerde module die gebruikmaakt van Windows-functies

[Maclane]

Enkele voorbeelden van het forum met FolderBrowse als trefwoord:

Een bladervenster toevoegen aan een

Hallo,  ik heb een macro die ik link, ik ben op zoek naar hoe ik FolderBrowse erin kan integreren om de map te kunnen selecteren waarin deze wordt opgeslagen    dxf.swp

Macro - pad map bestemming

Heel erg bedankt, dat is het precies. Is er een manier om de adresbalk van Windows in het venster te hebben om het kopiëren van bestemmingspaden te vergemakkelijken?

SW VBA-dialoogvenster map selecteren

Je moet kijken naar het laatste bericht van de vorige link die verwijst naar een link en een bericht van @liryc https://www.lynkoa.com/forum/solidworks/bouton-parcourir-macro-vba In de hoop dat het deze keer het juiste dialoogvenster is: Voor de code in de 1e module: Dim swApp als SldWorks.SldWorks Dim Bestandsnaam Als String Dim filter als string Dim fileConfig As String Dim bestandDispNaam als tekenreeks Bestand dimmenOpties zo lang "Sub main() 'Set swApp = Application.SldWorks 'F...

Macro om massaal te transformeren. SLDPRT van plaatwerk in ongevouwen in . DWG of .

Hallo, De definitieve versie komt binnenkort als er geen wijzigingen meer zijn... Vriendelijke groeten

[Cyril_f]

Dit is de code die ik gebruik:

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]

Dank u voor uw antwoorden.
Ik probeer er voor mijn vakantie naar te kijken en je feedback te geven.
anders wacht het nog even

[joris]

Nou, na verschillende tests concludeer ik dat het een veel complexer onderwerp is dan ik dacht, en dat mijn kennis over het onderwerp bijna nul is.
Ik zal niet in staat zijn om goed verder te gaan met al mijn problemen.

In ieder geval allemaal bedankt voor jullie feedback

[Cyril_f]

Hallo
Uit de code op het oorspronkelijke bericht:

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: Ik heb overgeslagen, de functie die ik gaf in het andere bericht staat je alleen toe om een map te selecteren, niet een bepaald bestand

[joris]

Hartelijk dank.