Hallo Community,
Ich würde gerne wissen, ob es ein Makro gibt, um ein einzelnes Teil unter STL aufzunehmen (unter anderem auswählen) oder ob wir alle Körper eines einzelnen Teils unabhängig voneinander aufnehmen können? Wenn Sie Tutorials oder ein ähnliches Makro haben, wäre es für mich sehr nützlich:)
Hallo
Ich habe diese Art von Makro bereits für Schritt gemacht, aber es ist im Grunde dasselbe für stl.
Option Explicit
Dim swApp As Object
Dim swPart As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim Indent As Long
Dim BodyFolderType(5) As String
Dim sModelName As String
Dim iNbCar As Integer
Dim boolstatus As Boolean
Dim fileName As String
Dim file2save As String
Dim swErrors As Long
Dim swWarnings As Long
Dim bRet As Boolean
Sub main()
BodyFolderType(0) = "dummy"
BodyFolderType(1) = "swSolidBodyFolder"
BodyFolderType(2) = "swSurfaceBodyFolder"
BodyFolderType(3) = "swBodySubFolder"
BodyFolderType(4) = "swWeldmentSubFolder"
BodyFolderType(5) = "swWeldmentCutListFolder"
Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Call StlParam
Debug.Print "File = " & swPart.GetPathName
fileName = swPart.GetPathName
fileName = Strings.Left(fileName, Len(fileName) - 7)
Indent = -3
Set swFeat = swPart.FirstFeature
TraverseFeatures swFeat, True
End Sub
Sub StlParam()
boolstatus = swApp.SetUserPreferenceToggle(swSTLBinaryFormat, True) 'Paramètre la sortie en tant que fichier Binaire
boolstatus = swApp.SetUserPreferenceIntegerValue(swExportStlUnits, 0) 'Parmaètre les unités à millimètres
boolstatus = swApp.SetUserPreferenceIntegerValue(swSTLQuality, swSTLQuality_e.swSTLQuality_Fine) 'Paramètre la résolution du fichier en fin
boolstatus = swApp.SetUserPreferenceToggle(swSTLShowInfoOnSave, True) 'Permet d'afficher les infos STL (maillage) avant d'enregistrer
boolstatus = swApp.SetUserPreferenceToggle(swSTLComponentsIntoOneFile, True) 'Paramètre l'enregistrement des composants d'un assemblage dans un seul fichier
End Sub
Sub DoTheWork(thisFeat As SldWorks.Feature)
Dim IsBodyFolder As Boolean
IsBodyFolder = False
Dim FeatType As String
FeatType = thisFeat.GetTypeName
If FeatType = "SolidBodyFolder" Then IsBodyFolder = True
If IsBodyFolder Then
Debug.Print Format(String(Indent, " ") & thisFeat.Name, "!" & String(40, "@")); Format(FeatType, "!" & String(30, "@"));
Dim BodyFolder As SldWorks.BodyFolder
Set BodyFolder = thisFeat.GetSpecificFeature2
Dim BodyFolderTypeE As Long
BodyFolderTypeE = BodyFolder.Type
Debug.Print Format(BodyFolderType(BodyFolderTypeE), "!" & String(30, "@")); Format(BodyFolderTypeE, "!@@@@");
Dim BodyCount As Long
BodyCount = BodyFolder.GetBodyCount
Debug.Print "Body Count is " & BodyCount
Dim vBodies As Variant
vBodies = BodyFolder.GetBodies
Dim i As Long
If Not IsEmpty(vBodies) Then
For i = LBound(vBodies) To UBound(vBodies)
Dim Body As SldWorks.Body2
Set Body = vBodies(i)
sModelName = Body.Name
If InStr(sModelName, "[") <> 0 Then
iNbCar = Len(sModelName) - (Len(sModelName) - InStr(sModelName, "[")) - 1
sModelName = Left(sModelName, iNbCar)
End If
Debug.Print sModelName
boolstatus = swPart.Extension.SelectByID2(Body.Name, "SOLIDBODY", 0, 0, 0, False, 0, Nothing, 0)
file2save = fileName & " - " & sModelName & ".stl"
Debug.Print file2save
boolstatus = swPart.SaveToFile2(file2save, swSaveAsOptions_e.swSaveAsOptions_Silent, swErrors, swWarnings)
Set swPart = swApp.ActiveDoc
swApp.CloseDoc (swPart.GetTitle)
Set swPart = swApp.ActiveDoc
'swPart.ClearSelection2 True
Debug.Print Format(String(Indent + 3, " ") & Body.Name, "!" & String(30, "@"))
Next i
End If
Dim FeatureFromBodyFolder As SldWorks.Feature
Set FeatureFromBodyFolder = BodyFolder.GetFeature
If Not FeatureFromBodyFolder Is thisFeat Then
MsgBox "Features don't match!"
End If
Else
End If
End Sub
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Dim curFeat As SldWorks.Feature
Set curFeat = thisFeat
Indent = Indent + 3
While Not curFeat Is Nothing
DoTheWork curFeat 'Do the thing that we are doing this feature traversal for
Dim subfeat As SldWorks.Feature
Set subfeat = curFeat.GetFirstSubFeature
While Not subfeat Is Nothing
TraverseFeatures subfeat, False
Dim nextSubFeat As SldWorks.Feature
Set nextSubFeat = subfeat.GetNextSubFeature
Set subfeat = nextSubFeat
Set nextSubFeat = Nothing
Wend
Set subfeat = Nothing
Dim nextFeat As SldWorks.Feature
If isTopLevel Then
Set nextFeat = curFeat.GetNextFeature
Else
Set nextFeat = Nothing
End If
Set curFeat = nextFeat
Set nextFeat = Nothing
Wend
Indent = Indent - 3
End Sub
So wie es aussieht, legt das Makro die stl-Optionen fest. Wenn Sie möchten, dass sie nach dem Eingreifen des Makros auf den Ursprung zurückgesetzt werden, müssen Sie die Werte beim Starten des Makros aus dem Ursprung abrufen und am Ende der Verarbeitung erneut anwenden.
Leider funktioniert es bei mir nicht, Debuggen auf der Ebene von (parametrisiert die Ausgabe als Binärdatei), und ich habe nicht die Fähigkeiten, das Problem zu lösen, ich weiß nicht viel über Codierung ... aber danke
Hallo, Sie benötigen eine geöffnete Datei, um auf die Einstellungen zugreifen zu können, sonst stürzt es ab.
Sie können eine Kontrolle darüber hinzufügen, ob eine Datei geöffnet ist oder nicht. Vor Call StlParam einzufügen
If swPart Is Nothing Then MsgBox ("Pas de document ouvert"): Exit Sub
Hallo
Selbst bei einer geöffneten Datei zeigt es mir das (PJ), es tut mir wirklich leid, aber ich weiß sehr wenig über Makrobearbeitung, ich habe es versucht , aber nie wirklich zu programmieren, es ist schwierig. Können Sie mir sagen, wie ich das Makro mache oder wird es möglich sein, das Makro direkt zu haben?
Ist Dim swApp auf Als Objekt eingestellt?
Welche Version von SW? Es ist funktionsfähig ab 2014/2016/2018 (Versionen, die das Makro durchlaufen hat)
Hallo
Es funktioniert auch sehr gut auf SW2017, überprüfen Sie, was Sie als Referenzen im Makro-Editor haben (Extras/Referenzen...).
Herzliche Grüße
Guten Abend
Dummes "Ding", aber du wirfst gut aus dem Sub_Main Spiel?
Hallo
Ja, ich bin im SW 2018 und hier sind meine Referenzen.
Ich habe Ihr Dokument kopiert und in den SOLIDWORKS Makro-Editor eingefügt ... Gibt es ein bestimmtes Verfahren?
Vielen Dank, dass Sie mir geholfen haben, das Makro zu verstehen und zu verwenden:)
Hallo
Das Einzige, was Sie tun können, ist, wenn Sie das Makro starten, wenn sich Ihr Cursor nicht in dem identifizierten Block zwischen Sub_main und End-Sub befindet, müssen Sie Macrox.modulex.main auswählen (das x ist wahrscheinlich 1).
Wenn Sie sich schließlich dafür entscheiden, dieses Makro auf eine benutzerdefinierte Schaltfläche zu setzen, müssen Sie den Pfad und das Makro im Feld "Makro" auswählen und dann im Feld "Methode" Macrox.main auswählen
Guten Abend
Leider Cyril.f, ich mache alles so, wie du es dir sagst, aber es funktioniert nicht. Darf ich Sie bitten, ein Tutorial oder eine Sequenz von Screenshots zu machen, damit ich verstehe.... Ich verstehe nicht, warum es nicht funktioniert.
Guten Abend
Ehrlich gesagt sehe ich nicht, wo das Problem liegen könnte, und Screenshots würden das Problem meiner Meinung nach nicht lösen. Wenn d.roger eine Idee hat
Guten Abend
Ich habe Solidworks nicht zur Hand, daher ist es nicht möglich, Bilder von den verschiedenen Schritten zu erstellen.
Ein paar Checks:
- Haben Sie manuell Zugriff auf die STL-Exportoptionen (öffnen Sie ein Teil, gehen Sie zu Systemoption / Exportieren / STL-Format)?
- Hatten Sie nur einen Prozess sldworks.exe gestartet?
- Sind Sie Administrator auf Ihrem PC?
Um Ihr Makro zu erstellen, müssen Sie Folgendes tun:
- Starten Sie Solidworks (überprüfen Sie übrigens, ob nur ein sldworks.exe Prozess gestartet wurde).
- Erstellen Sie ein neues Dokument, das Sie in einem Ordner speichern, für den Sie Schreibrechte haben (z. B. auf dem Desktop).
- Gehen Sie zu Extras/Makro/News.
-Im sich öffnenden VBA-Fenster müssen Sie alles löschen und dann den gesamten Text des Makros von Cyril.f einfügen.
- Positionieren Sie den Cursor auf eine Zeile im Hauptmodul.
- Starten Sie das Makro.
Dies sollte funktionieren und eine stl-Datei Ihres Teils erstellen, diese wird am selben Ort wie Ihr sldprt-Teil gespeichert.
Wenn es an der gleichen Stelle wie zuvor hängen bleibt, können Sie die Zeile "Call StlParam" im Sub Main() sowie alle Zeilen im "Sub StlParam()" auskommentieren und das Makro erneut ausführen, um zu sehen, ob es funktioniert.
Herzliche Grüße
Vielen Dank!!!! Es funktioniert, wenn ich es auf diese Weise einschalte. Ich habe das Makro über den Play-Button aktiviert, allerdings ohne überzeugende Ergebnisse. Es funktioniert immer noch nicht, wenn ich Makro ausführen und Makro auswähle, während es funktioniert, wenn ich es bearbeite und einschalte. Seltsam oder normal?
Hallo
OK, also ersetzen Sie die Zeilen:
Sub StlParam() von der Funktion StlParam()
Sub DoTheWork(thisfeat As SldWorks.Feature) by function DoTheWork(thisfaat As SldWorks.Feature)
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean) by Function TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Anschließend überprüfen Sie, ob die Endunterzeilen , die diesen Funktionen entsprechen, durch Endfunktion ersetzt wurden. Sie sollten nur einen Unterblock in Ihrem Makro haben, dies ist der Startblock des Makros und es sollte auf Abruf über eine Schaltfläche oder über Extras/Makro/Ausführen funktionieren.
Wenn es funktioniert, können Sie die beste Antwort validieren, es ist Cyril.f , wo er den gesamten Makrotext eingefügt hat, dort ist die ganze Arbeit.
Herzliche Grüße
Hallo
Es funktioniert perfekt :) Vielen Dank an Sie beide, insbesondere an Cyril.f für das Teilen des Makros, es ist verrückt, wie wir durch die Arbeit an der gleichen Software überhaupt nicht die gleichen Funktionen, Fähigkeiten und Tätigkeitsfelder haben. Und danke an D.Roger für die Hilfe und das Verständnis von Makros, was überhaupt nicht in meinem Fachgebiet liegt.
Hallo
Nehmen wir an, wenn Sie anfangen, sich damit zu beschäftigen, wie Sie bestimmte Aufgaben automatisieren können (SW hatte bestimmte Funktionen zu einem bestimmten Zeitpunkt nicht nativ) und Sie ein wenig Autodidakt sind, haben Sie am Ende eine gewisse Beherrschung von Makros. Insgesamt müssen Sie nur loslegen, ein wenig Zeit haben, die Hilfe der API und der Websites nutzen und am Ende erwerben Sie ein ausreichendes Niveau im Allgemeinen.