Hallo
Ich habe ein IGES aus einer Assembly importiert. Solidworks erstellt alle Teile für mich, aber für jedes von ihnen muss ich eine Importdiagnose durchführen, um die Flächen zu reparieren.
Gibt es eine Möglichkeit, alle Teile zu befestigen, ohne sie 1 zu 1 zu öffnen?
Nein
Hallo
Meines Wissens nicht, aber mit Hilfe eines Makros ist es sicherlich möglich.
Schönen Tag
Nun ja, endlich habe ich ein Makro gemacht, es hat mich 5min gekostet. Sie müssen nicht weiter suchen, obwohl es schön gewesen wäre, eine eigene Funktion zu haben:)
Hallo
Können Sie es teilen?
Auch wenn es kurz und bündig ist, kann es praktisch sein.
Vielen Dank
Ich bin kein VBA-Profi, ich habe nur gebastelt, aber es funktioniert. Ich habe auch einen BrowseFolder eingefügt.
Option Explizit
Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc
Dim sFileName als Zeichenfolge
Dateiname als Zeichenfolge dimmen
Pfad als Zeichenfolge dimmen
Dimmen newPath als Zeichenfolge
Dim swLayerMgr As SldWorks.LayerMgr
Dim swLayer als SldWorks.Layer
Dim nErrors so lange
Dimmen nWarnungen so lange
Dim boolstatus als boolescher Wert
Dim longstatus As Long
Dim longwarnings So lange
Private Const BIF_RETURNONLYFSDIRS so lang = &h1
Private Const BIF_DONTGOBELOWDOMAIN so lang = &h2
Private Const BIF_RETURNFSANCESTORS so lang = &h8
Private Const BIF_BROWSEFORCOMPUTER Solange = &H1000
Private Const BIF_BROWSEFORPRINTER Solange = &H2000
Private Const BIF_BROWSEINCLUDEFILES Solange = &H4000
Private Const MAX_PATH Solange = 260
Funktion BrowseFolder(Optional Caption As String, Optional InitialFolder As String) Als String
Ordner als Objekt dimmen
Dim F als Ordner
ShellApp als Objekt dimmen
Set ShellApp = CreateObject("Shell.Application")
Set F = ShellApp.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
Wenn nicht, ist F nichts, dann
Wenn F = "Desktop" dann
BrowseFolder = Über("BENUTZERPROFIL") & "\Desktop"
Oder
BrowseFolder = F.Items.Item.Path
Ende, wenn
Ende, wenn
Ende-Funktion
Sub main()
Legen Sie swApp = Application.SldWorks fest
' Auswählen des Quellordners
Path = BrowseFolder(Caption:="Quellordner auswählen")
Wenn Pfad = "" dann
'MsgBox "Quellordner auswählen"
Ende
Oder
Pfad = Pfad & "\"
Ende, wenn
sFileName = Verzeichnis(Pfad & "*.sldprt")
Ausführen, bis sFileName = ""
Set swModel = swApp.OpenDoc6(Pfad + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Festlegen von swModel = swApp.ActiveDoc
longstatus = swModel.ImportDiagnosis(Wahr, Falsch, Wahr, 0)
Dim swErrors so lange
Dim swWarnungen so lange
boolstatus = swModel.Save3(1, swFehler, swWarnungen)
swApp.CloseDoc swModel.GetTitle
Set swModel = Nichts
sFileName = Verzeichnis
Schleife
Ende Sub