Hallo gemeenschap,
Ik zou graag willen weten of er een macro is om een enkel onderdeel onder STL op te nemen (selecteer onder andere) of dat we alle lichamen van een enkel onderdeel onafhankelijk kunnen opnemen? Als je tutorials of een vergelijkbare macro hebt, zou het erg handig voor mij zijn:)
Hallo
Ik heb dit soort macro's al gedaan voor stap, maar het is in principe hetzelfde voor 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
Zoals het er nu uitziet, stelt de macro de stl-opties in. Als u wilt dat ze worden teruggezet naar de oorsprong nadat de macro is ingegrepen, moet u de waarden van de oorsprong ophalen wanneer de macro wordt gestart en deze vervolgens aan het einde van de verwerking opnieuw toepassen.
Helaas werkt het niet voor mij, debuggen op het niveau van (parametriseert de uitvoer als een binair bestand), en ik heb niet de vaardigheden om het probleem op te lossen, ik weet niet veel over coderen... maar bedankt
Hallo, je hebt een open bestand nodig om toegang te krijgen tot de instellingen, anders crasht het.
U kunt een controle toevoegen over of een bestand open is of niet. In te voegen vóór Call StlParam
If swPart Is Nothing Then MsgBox ("Pas de document ouvert"): Exit Sub
Hallo
Zelfs met een open bestand laat het me dit zien (PJ), het spijt me echt, maar ik weet heel weinig over macro-bewerking, ik heb het geprobeerd , maar nooit echt coderen, het is moeilijk. Kunt u mij vertellen hoe ik de macro moet doen of zal het mogelijk zijn om de macro direct te hebben?
Is Dim swApp ingesteld op Als object?
Welke versie van SW? Het is functioneel op 2014/2016/2018 (versies die de macro heeft doorlopen)
Hallo
Het werkt ook heel goed op SW2017, controleer wat je als referenties hebt in de macro-editor (Tools/References...).
Vriendelijke groeten
Goedenavond
Stom "ding", maar je gooit goed van de Sub_Main spel?
Hallo
Ja, ik ben op SW 2018 en hier zijn mijn referenties.
Ik heb uw document gekopieerd en geplakt in de solidworks macro-editor... Is er een specifieke procedure die moet worden gevolgd?
Bedankt dat je me hebt geholpen de macro te begrijpen en te gebruiken:)
Hallo
Het enige dat u kunt doen, is wanneer u de macro start, als uw cursor zich niet in het geïdentificeerde blok tussen Sub_main en eindsub bevindt, u Macrox.modulex.main moet selecteren (de x is waarschijnlijk 1).
Uiteindelijk, als je ervoor kiest om deze macro op een aangepaste knop te zetten, zul je het pad en de macro moeten selecteren in het veld "Macro" en vervolgens in het veld "Methode" Macrox.main moeten selecteren
Goedenavond
Helaas Cyril.f, ik doe alles wat je zegt, maar het werkt niet. Mag ik je vragen om een tutorial of een reeks screenshots te maken, zodat ik het begrijp.... Ik zie niet in waarom het niet werkt.
Goedenavond
Eerlijk gezegd zie ik niet waar het probleem zou kunnen zitten en screenshots zouden het probleem niet oplossen, denk ik. Als D.Roger een idee heeft
Goedenavond
Ik heb geen Solidworks bij de hand, dus het is niet mogelijk om afbeeldingen te maken van de verschillende stappen.
Een paar controles:
- Heeft u handmatig toegang tot de STL-exportopties (open een onderdeel, ga naar Systeemoptie / Exporteren / STL-indeling)?
- Had je maar één proces sldworks.exe gestart?
- Bent u een beheerder op uw pc?
Om uw macro te maken, moet u het volgende doen:
- Start Solidworks (controleer overigens of er maar één sldworks.exe proces is gestart).
- Maak een nieuw document aan dat je opslaat in een map waarop je schrijfrechten hebt (bijvoorbeeld op het bureaublad).
- Ga naar Extra/Macro/Nieuws.
-In het VBA-venster dat wordt geopend, moet je alles verwijderen en vervolgens alle tekst van de macro van Cyril.f plakken.
- Plaats de cursor op een rij in de hoofdmodule.
- Start de macro.
Dit zou moeten werken en maak een stl-bestand van uw onderdeel, dit wordt op dezelfde plaats opgeslagen als uw sldprt-onderdeel.
Als het vast komt te zitten op dezelfde plaats als voorheen, kun je de "Call StlParam" regel in de Sub Main() en alle regels in de "Sub StlParam()" becommentariëren en de macro opnieuw uitvoeren om te zien of het werkt.
Vriendelijke groeten
Bedankt!!!! Het werkt als ik het op deze manier aanzet. Ik heb de macro geactiveerd via de afspeelknop, maar zonder overtuigend resultaat. Het werkt nog steeds niet als ik Macro uitvoeren en macro selecteer, terwijl wanneer ik het bewerk en inschakel, het werkt. Vreemd of normaal?
Hallo
OK, dus je vervangt de regels:
Sub StlParam() op functie StlParam()
Sub DoTheWork(thisFeat As SldWorks.Feature) door Function DoTheWork(thisFeat As SldWorks.Feature)
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean) by Function TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Vervolgens controleert u of de End Sub-regels die overeenkomen met deze functies zijn vervangen door End Function. U zou slechts één subblok in uw macro moeten hebben, dit is het startblok van de macro en het zou op afroep moeten werken met een knop of met Tools/Macro/Run.
Als het werkt, kun je het beste antwoord valideren, het is Cyril.f waar hij alle macrotekst heeft geplaatst, dat is waar al het werk is.
Vriendelijke groeten
Hallo
Het werkt perfect :) Heel erg bedankt aan jullie beiden, vooral aan Cyril.f voor het delen van de macro, het is gek hoe we door aan dezelfde software te werken helemaal niet dezelfde functies, mogelijkheden en werkterreinen hebben. En dank aan D.Roger voor de hulp en het begrip van macro's, wat helemaal niet in mijn vakgebied ligt.
Hallo
Laten we zeggen dat wanneer je begint te kijken naar hoe je bepaalde taken kunt automatiseren (SW had bepaalde functies ooit niet native) en je bent een beetje autodidact, je uiteindelijk een zekere beheersing van macro's hebt. Over het algemeen hoef je alleen maar aan de slag te gaan, wat tijd te hebben, de hulp van de API en de websites te gebruiken en uiteindelijk verwerf je over het algemeen een voldoende niveau.