Da ich nicht viel Ahnung von Makros habe, trockne ich schnell bei dem Thema aus
Ich habe das folgende Makro in Solidworks 2022 aufgezeichnet:
Dimmen swApp als Objekt
Teil als Objekt dimmen Dim boolstatus als boolescher Wert Dim longstatus As Long, longwarnings As Long
Sub main()
Festlegen von swApp = Application.SldWorks
boolstatus = swApp.LoadFile2(" C:\temp\Neuer Ordner\test.stl ", " r ") Set Part = swApp.ActiveDoc myModelView als Objekt dimmen Festlegen von myModelView = Part.ActiveView myModelView.FrameState = swWindowState_e.swWindowMaximized
' Speichern unter longstatus = Part.SaveAs3(" C:\temp\Neuer Ordner\test. SLDPRT ", 0, 0) Ende Sub
Es ermöglicht mir, eine STL zu importieren und als Teil zu speichern. Ich könnte es manuell machen, aber das ist erst der Anfang meines Wunsches nach Automatisierung
In einem 1. Schritt möchte ich die Möglichkeit haben, die STL-Datei auszuwählen, die ich importieren möchte. Ich kann kein Beispiel finden, das mir hilft, und ich habe eine KI durchlaufen, die mein Problem löst, indem sie Fehler in alle Richtungen hinzufügt.
Hallo; Hier ist ein Beispiel für den Aufruf des Windows-Dateibrowsers:
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 diesem Beispiel rufe ich den Verweis absichtlich auf Excel auf, um Kompatibilitätsprobleme mit der Solidworks API zu vermeiden. => … Wechseln Sie im SolidWorks VBA-Editor zu Extras > Referenzen... Die Referenz sollte hinzugefügt werden: Microsoft Office XX.0 Object Library " (wobei XX von Ihrer Office-Version abhängt). In diesem Beispiel ist die Variable " MyWay " das Äquivalent Ihrer Linie:
…
Persönliche Anmerkung: Um im Makro zu starten, zögern Sie nicht , den Befehl " Debug.print " zu verwenden Beispiel: Debug.print MyPath gibt den Wert der Variablen " MyPath " im Ausführungsfenster des VBA-Editors an. Die zweite Operation zum Verständnis des Codes ist der Schritt-für-Schritt-Modus (F8), der mit dem Fenster " Lokale Variable " verknüpft ist, und das Fenster " Ausführung " des Editors erleichtert das Lesen und Verstehen des Codes: Die Ausführung des Codes im Schrittmodus erfolgt Zeile für Zeile (jeweils bei F8) und die vom Makro " abgerufenen" Daten werden im Fenster " Lokale Variablen" sichtbar
Hallo Es gibt eine FolderBrowse-Funktion (wenn ich mich richtig erinnere, von einem Code, der in diesem Forum geteilt wurde, oder dem alten), die ich verwende und die perfekt mit SW funktioniert, ohne Excel-Funktionen zu verwenden.
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
Nun, nach verschiedenen Tests komme ich zu dem Schluss, dass es ein viel komplexeres Thema ist, als ich dachte, und dass mein Wissen zu diesem Thema nahe Null ist. Ich werde nicht in der Lage sein, mit all meinen Problemen richtig voranzukommen.
Hallo Aus dem Code in der ursprünglichen Nachricht:
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
Bearbeiten: Ich habe übersprungen, die Funktion, die ich in der anderen Nachricht angegeben habe, ermöglicht es Ihnen nur, einen Ordner auszuwählen, nicht eine bestimmte Datei
