Ok, dziękuję za wyjaśnienia.
A ja byłem dobrze w rozdzielczości i nadal mam tylko 4 z 7 elementów, które mają kostkę wizualizacji.
Ok, dziękuję za wyjaśnienia.
A ja byłem dobrze w rozdzielczości i nadal mam tylko 4 z 7 elementów, które mają kostkę wizualizacji.
Kiedy uruchamiam zmodyfikowane makro na większym złożeniu, tworzy ono wszystkie kostki wizualizacji, czy nie masz żadnych części powierzchni? a która wersja SW?
Nie, nie mam żadnych części powierzchniowych, a moja wersja to 2018
Właśnie ponownie przeprowadziłem kilka testów i nadal to samo jest moim montażem, jeśli chcesz zrobić kilka testów
Zrobiłem test na innym zespole z 7 częściami i tam działa, nie wiem dlaczego nie działa z tym.
Może zobaczysz coś po swojej stronie.
Czy możesz mi powiedzieć, czy ten kod działa na częściach symetrycznych, czy z powtórzeniem komponentu.
Zrobię kilka testów z mojej strony, aby to sprawdzić, ale jestem ciekaw Twojej opinii
Otrzymuję kostkę wizualizacji na wszystkich częściach twojego zespołu.
Zmodyfikowałem kod w następujący sposób, aby usunąć całą masę linii, które prawdopodobnie nie służą żadnemu celowi:
Dim swApp As Object
'Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
'Dim j As Long
'Dim cCnt As Long
Dim Assembly As ModelDoc2
Dim myAsy As AssemblyDoc
Dim myCmps
Dim CmpDoc As ModelDoc2
Dim myCmp As Component2
'Dim tCmp As Component2
Sub main()
'Dim myModelView As Object
Set swApp = Application.SldWorks
'Set Part = swApp.ActiveDoc
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly
myCmps = myAsy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
'cCnt = 0
Set CmpDoc = myCmp.GetModelDoc
'Cfg = myCmp.ReferencedConfiguration
'compte le nombre d'occurences des composants
'For j = 0 To UBound(myCmps)
'Set tCmp = myCmps(j)
'If tCmp.GetSuppression <> 0 Then
'If tCmp.GetModelDoc2 Is CmpDoc Then
'If tCmp.ReferencedConfiguration = Cfg Then
'cCnt = cCnt + 1
'End If
'End If
'End If
'Next j
Document = CmpDoc.GetPathName
'remplissage propriété Type
'If Not CmpDoc.GetPathName Like "*\AppData\*" Then
'T = CmpDoc.CustomInfo("Type")
'Debug.Print T
'If T = "" Then
Set swModel = swApp.ActivateDoc(Document)
'swModel.ForceRebuild ' Reconstruction
'swModel.ShowNamedView2 "*Isométric", -1 ' Vue Isométrique
'swModel.ViewDisplayShaded ' Vue Ombrée
'swModel.ViewZoomtofit2 ' Zoom au mieux
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
'Part.GraphicsRedraw2
'Dim BoundingBox As Object
'Set BoundingBox = Part.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
'Part.ClearSelection2 True
'Enregistre et ferme le document actif en mode silencieux
bRet = CmpDoc.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
swApp.CloseDoc (Document)
'Else
'End If
'End If
End If
Next i
MsgBox "Cube créé", vbExclamation
End Sub
Ok, dziękuję za opinię, więc nie rozumiem dlaczego w domu mam problemy, ale może później będę miał wyjaśnienie.
Dziękuję za uporządkowanie kodu, pracowałem również po swojej stronie, aby usunąć to, co nie jest przydatne, ale porównam z Twoim.
Tymczasem wielkie podziękowania za pomoc.
Jeśli będę miał problem wrócę do wątku, w międzyczasie zweryfikuję Twój ostatni post
Kolejne pytanie, które mnie nurtuje, otwieramy wszystkie elementy, ale w złożeniu możemy edytować bez otwierania i oszczędza to czas.
Czy można zrobić to samo z tym makrem?
PS: Twój kod był o wiele bardziej dopracowany niż mój.
Witam
Tak, jest to możliwe w przypadku funkcji EditPart2 , ale należy uważać, aby nie pomylić ModelDoc2, AssemblyDoc i Component2.
Pozdrowienia
Witam
Czy masz coś, co pozwala mi zrozumieć różnicę między tymi funkcjami?
Ponieważ moje badania są zbyt niejasne, aby się w nich odnaleźć.
Witam
Oto przykład, który powinien zrobić to samo, co makro już dostarczone:
Option Explicit
Dim swApp As Object
Dim longstatus As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2
Dim nInfo As Long
Sub main()
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAssy = Assembly
myCmps = myAssy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
bRet = myCmp.Select2(False, 0)
bRet = myAssy.EditPart2(True, True, nInfo)
Set swModel = myAssy.GetEditTarget
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
myAssy.EditAssembly
End If
Next i
Assembly.ForceRebuild3 True
MsgBox "Cubes créés", vbExclamation
End Sub
Pozdrowienia
Dobry wieczór
Właśnie wypróbowałem twój kod, ale powoduje to awarię Solidworks 2018.
Nie podając mi żadnych elementów, dlaczego się rozbił.
Czy możesz mnie poprowadzić?
Witam
Nie widzę żadnego powodu, dla którego to makro powoduje awarię oprogramowania, wszystkie używane funkcje są wcześniejsze niż SW2018. Umieść ponumerowane pola MsgBox między każdym krokiem, aby zobaczyć, przy jakiej funkcji ulega awarii...
Pozdrowienia
Witam
Oto linia, która powoduje awarię Solidworks:
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
Witam
Przypominamy, że podane tutaj makra są tylko przykładowe i muszą zostać przerobione, aby przynajmniej dodać obsługę błędów...
Musisz więc dodać tę obsługę błędów (patrz TUTAJ) w pętli For i eskalować, jeśli chcesz, ten błąd w argumencie swErrors (patrz TUTAJ) funkcji Save3 .
Pozdrowienia
Przepraszam, ale to nie linijka, którą zacytowałem powyżej, powoduje u mnie awarię Solidworks, po prostu przerobiłem kilka testów i ostatecznie jest to ten:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Nie rozumiem jednak, ponieważ jest to ten sam kod, który działał w poprzednim makrze.
I dziękuję za wyjaśnienia dotyczące Save3, przyjrzę się temu.
Odpowiedź jest prawie taka sama jak poprzednio: wstaw obsługę błędów i odczytaj typ błędu w zmiennej longstatus, zobacz TUTAJ , aby zapoznać się z możliwym typem zwracanego błędu.
Witam
Próbowałem poradzić sobie z błędem, ale nadal ten sam problem, czyli Solidworks wywala na linii:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Pomimo obsługi błędów, Solidworks ulega awarii bez otwierania msgbox, czy jest problem z kodem obsługi mojego błędu, ponieważ msgbox powinien się pojawić, jeśli zostanie wykryty błąd.
Nie wykryto więc żadnego błędu, więc co może być problemem?
Oto kod z obsługą błędów:
Option Explicit
Dim swApp As Object
Dim longstatus As Long
Dim swModel As SldWorks.ModelDoc2
Dim bRet As Boolean
Dim swErrors As Long
Dim swWarnings As Long
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2
Dim nInfo As Long
'Public Enum swGlobalBoundingBoxResult_e
'Inherits System.Enum
Sub main()
Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAssy = Assembly
'Dim instance As swGlobalBoundingBoxResult_e
myCmps = myAssy.GetComponents(False)
For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
bRet = myCmp.Select2(False, 0)
bRet = myAssy.EditPart2(True, True, nInfo)
Set swModel = myAssy.GetEditTarget
On Error GoTo errorHandler
Dim BoundingBox As Object
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
myAssy.EditAssembly
End If
Next i
Assembly.ForceRebuild3 True
MsgBox "Cubes créés", vbExclamation
Exit Sub
errorHandler:
'indique si l'erreur est detecte
MsgBox "erreur"
End Sub
Witam
Brak opinii na temat mojej obsługi błędów, czy jest ona poprawna, czy wcale?
Z góry dziękuję
Witam @treza88
[HS wł.]
Małe pytanie z czystej ciekawości ;-)
Jaki jest pożytek z posiadania kostki wizualizacji dla pomieszczenia, a zwłaszcza jaki jest pożytek z ASM, aby mieć kostkę wizualizacji dla każdego pomieszczenia.
Osobiście nigdy nie korzystam z kostki wizualizacyjnej.
[HS /wył.]
Pozdrowienia