Witaj Społeczności,
Chciałbym się dowiedzieć, czy istnieje makro do nagrywania pojedynczej części w STL (wybierz między innymi), czy też możemy nagrywać wszystkie bryły pojedynczej części niezależnie? Jeśli masz tutoriale lub podobne makro to byłoby mi bardzo przydatne :)
Witam
Zrobiłem już ten typ makra dla kroku, ale jest to w zasadzie to samo dla 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
W obecnej postaci makro ustawia opcje stl. Jeśli chcesz, aby zostały zresetowane do punktu początkowego po interwencji makra, musisz pobrać wartości z punktu początkowego po uruchomieniu makra , a następnie zastosować je ponownie po zakończeniu przetwarzania.
Niestety u mnie to nie działa, debugowanie na poziomie (parametryzuje wyjście jako plik binarny), a ja nie mam umiejętności, aby rozwiązać problem, nie znam się na kodowaniu... ale dziękuję
Witam, potrzebujesz otwartego pliku, aby uzyskać dostęp do ustawień, w przeciwnym razie ulegnie awarii.
Możesz dodać kontrolkę nad tym, czy plik jest otwarty, czy nie. Do wstawienia przed wywołaniem StlParam
If swPart Is Nothing Then MsgBox ("Pas de document ouvert"): Exit Sub
Witam
Nawet z otwartym plikiem pokazuje mi to (PJ), bardzo mi przykro, ale bardzo mało wiem o edycji makr, próbowałem , ale nigdy tak naprawdę kodowanie jest trudne. Czy możesz mi powiedzieć, jak zrobić makro, czy będzie można mieć makro bezpośrednio?
Czy Dim swApp jest ustawiony na Jako obiekt?
Która wersja oprogramowania? Działa w latach 2014/2016/2018 (wersje, przez które przeszło makro)
Witam
Działa bardzo dobrze również na SW2017, sprawdź, co masz jako referencje w edytorze makr (Narzędzia/Referencje...).
Pozdrowienia
Dobry wieczór
Głupie "coś", ale dobrze rzucasz z Sub_Main gry?
Witam
Tak, jestem na SW 2018 i oto moje referencje.
Skopiowałem i wkleiłem Twój dokument do edytora makr solidworks... Czy istnieje jakaś szczególna procedura, którą należy podjąć?
Dziękuję za pomoc w zrozumieniu i korzystaniu z makra :)
Witam
Jedyne, co możesz zrobić, to po uruchomieniu makra, jeśli kursor nie znajduje się w zidentyfikowanym bloku między Sub_main a end sub, musisz wybrać Macrox.modulex.main (x to prawdopodobnie 1).
Ostatecznie, jeśli zdecydujesz się umieścić to makro na przycisku niestandardowym, będziesz musiał wybrać ścieżkę i makro w polu "Makro", a następnie w polu "Metoda" wybierz Macrox.main
Dobry wieczór
Niestety Cyril.f, robię wszystko tak jak ci każesz, ale to nie działa. Czy mogę prosić o zrobienie samouczka lub sekwencji zrzutów ekranu, żebym zrozumiał.... Nie rozumiem, dlaczego to nie działa.
Dobry wieczór
Szczerze mówiąc, nie widzę, gdzie może być problem, a zrzuty ekranu nie rozwiązałyby problemu, jak sądzę. Jeśli d.roger ma pomysł
Dobry wieczór
Nie mam pod ręką Solidworks, więc nie jest możliwe wykonanie obrazów różnych kroków.
Kilka kontroli:
- Czy masz dostęp do opcji eksportu STL ręcznie (otwórz część, przejdź do Opcji systemu / Eksportu / Formatu STL)?
- Czy miałeś tylko jeden proces sldworks.exe uruchomieniu?
- Czy jesteś administratorem na swoim komputerze?
Aby utworzyć makro, musisz wykonać następujące czynności:
- Uruchom Solidworks (nawiasem mówiąc, sprawdź, czy uruchomiony jest tylko jeden proces sldworks.exe).
- Utwórz nowy dokument, który zapiszesz w folderze, w którym masz prawa do pisania (na przykład na pulpicie).
- Przejdź do Narzędzia/Makro/Wiadomości.
-W otwartym oknie VBA musisz usunąć wszystko, a następnie wkleić cały tekst makra Cyril.f.
- Umieść kursor w wierszu w module głównym.
- Uruchom makro.
To powinno zadziałać i utworzyć plik stl twojej części, który jest przechowywany w tym samym miejscu, co twoja część sldprt.
Jeśli utknie w tym samym miejscu co poprzednio, możesz skomentować wiersz "Call StlParam" w Sub Main(), a także wszystkie wiersze w "Sub StlParam()" i ponownie uruchomić makro, aby sprawdzić, czy działa.
Pozdrowienia
Dziękuję!!!! Działa, gdy włączę go w ten sposób. Aktywowałem makro za pomocą przycisku odtwarzania, ale bez przekonujących rezultatów. Nadal nie działa, gdy uruchamiam makro i wybieram makro, podczas gdy gdy edytuję je i włączam, działa. Dziwne czy normalne?
Witam
OK, więc zamieniasz wiersze:
Sub StlParam() przez funkcję StlParam()
Sub DoTheWork(thisFeat As SldWorks.Feature) przez funkcję DoTheWork(thisFeat As SldWorks.Feature)
Sub TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean) by Function TraverseFeatures(thisFeat As SldWorks.Feature, isTopLevel As Boolean)
Następnie należy sprawdzić, czy wiersze podrzędne końca odpowiadające tym funkcjom zostały zastąpione wierszami końcowymi. Powinieneś mieć tylko jeden blok podrzędny w swoim makrze, jest to blok początkowy makra i powinien działać na żądanie za pomocą przycisku lub przez Narzędzia/Makro/Uruchom.
Jeśli to zadziała, możesz zweryfikować najlepszą odpowiedź, to Cyril.f umieścił cały tekst makra, tam jest cała praca.
Pozdrowienia
Witam
Doskonale sprawdza się :) Bardzo dziękuję wam obojgu, szczególnie Cyril.f za udostępnienie makra, to szaleństwo, jak pracując na tym samym oprogramowaniu w ogóle nie mamy tych samych funkcji, możliwości i pól działania. I dziękuję D.Rogerowi za pomoc i zrozumienie makr, czego w ogóle nie ma w mojej specjalizacji.
Witam
Powiedzmy, że kiedy zaczynasz zastanawiać się, jak zautomatyzować pewne zadania (oprogramowanie nie miało kiedyś natywnie pewnych funkcji) i jesteś trochę samoukiem, w końcu osiągniesz pewne mistrzostwo w makrach. Ogólnie rzecz biorąc, wystarczy zacząć, poświęcić trochę czasu, skorzystać z pomocy interfejsu API i stron internetowych, a w końcu osiągniesz ogólny wystarczający poziom.