Hallo allemaal,
Is het mogelijk om in een assembly een visualisatiekubus te maken voor alle onderdelen die in dezelfde assembly aanwezig zijn?
omdat ik de indruk heb dat je elk stuk moet bewerken om de kubus te maken.
Is er een manier om dit te doen of om door een vba-lus de creatie van een visualisatiekubus voor elke kamer te automatiseren.
Bij voorbaat dank.
Hallo
Om het op de onderdelen te maken, zowel per macro als handmatig, moet u elk onderdeel bewerken.
Maar het is sneller en eenvoudiger per macro, omdat het met één klik is gedaan.
Vriendelijke groeten
Hallo en bedankt d.roger voor je tussenkomst,
Ik codeer in VBA voor Excel, maar VBA voor Solidworks is een probleem voor mij.
Ik heb geprobeerd een code te wijzigen die alle onderdelen van een assembly opent en elke keer dat ik de visualisatiekubus opende, te maken, maar er wordt geen kubus voor mij gemaakt.
En ik zie niet in waar het mis is.
Voor het geval ik de macro zet als iemand ziet waar het probleem is.
U maakt de kubus op de variabele Deel met deze regel "Set BoundingBox = Part. FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)" behalve dat de variabele "Part" aan uw assembly is gekoppeld, omdat het aan het begin de "swApp.ActiveDoc" is, dus wanneer ik uw macro start, wordt de kubus gemaakt op de assembly. U moet uw kubus maken op de variabele "swModel", het deel dat u opent door de actie van de regel "Set swModel = swApp.ActivateDoc(Document)", dus een eerste wijziging is om in ieder geval de regels als volgt te corrigeren:
If Not CmpDoc.GetPathName Like "*\AppData\*" Then
T = CmpDoc.CustomInfo("Type")
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
Deze macro wordt dan functioneel...
Vriendelijke groeten
Net als bij de andere discussie:
En zet je munten in de opgeloste modus anders werkt het niet...
Vriendelijke groeten
Bedankt voor deze eerste stap, aan de andere kant heb ik 7 onderdelen in mijn assemblage en zijn er maar 4 onderdelen die een visualisatiekubus hebben, de laatste 3 niet.
Er moet een probleem zijn in de lus, dat het niet rekening zou houden met alle onderdelen?
Sorry, maar wat is de opgeloste modus, excuseer mijn onwetendheid.
Bij het laden van een assemblage in Solidworks is het mogelijk om de onderdelen in opgeloste of lichte modus te openen, het verschil is dat de onderdelen daadwerkelijk open zijn of dat er alleen een grafische visualisatie van op het scherm wordt weergegeven. Zie HIER voor de voordelen van de opgeloste modus en HIER voor lichtgewicht onderdelen.
Klik dus met de rechtermuisknop op de assemblage en selecteer "Lichtgewicht onderdelen instellen op Opgelost" in het contextmenu en probeer vervolgens uw macro opnieuw.
Vriendelijke groeten
Ok, bedankt voor de verduidelijkingen.
En ik was goed in resolutie en ik heb nog steeds maar 4 van de 7 stukken die een visualisatiekubus hebben.
Wanneer ik de gewijzigde macro op een grotere assemblage start, worden alle visualisatiekubussen gemaakt, hebben jullie geen oppervlakteonderdelen? en welke versie van SW?
Nee, ik heb geen oppervlaktedelen en mijn versie is een 2018
Ik heb net weer wat tests gedaan en nog steeds hetzelfde, hier is mijn assemblage als je wat tests wilt doen
Ik heb een test gedaan op een andere assemblage met 7 onderdelen en daar werkt het, ik weet niet waarom het niet werkt met deze.
Misschien zie je iets aan je kant.
Kunt u mij vertellen of deze code werkt op symmetrische onderdelen of met een componentherhaling.
Ik zal wat tests aan mijn kant doen om te controleren, maar ik ben geïnteresseerd in uw mening
Ik krijg de visualisatiekubus op alle onderdelen van uw assemblage.
Ik heb de code als volgt aangepast om een hele reeks regels te verwijderen die waarschijnlijk geen enkel doel dienen:
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 bedankt voor je feedback, dus ik begrijp niet waarom ik thuis problemen heb, maar misschien heb ik later een verklaring.
Bedankt voor je opschoning van de code, ik heb ook aan mijn kant gewerkt om te verwijderen wat niet nuttig is, maar ik zal het vergelijken met de jouwe.
In de tussentijd hartelijk dank voor uw hulp.
Als ik een probleem heb, kom ik in de tussentijd terug op de draad, ik zal je laatste bericht valideren
Een andere vraag die me stoort, we openen alle stukken, maar in een assemblage kunnen we bewerken zonder te openen en dat bespaart tijd.
Is het mogelijk om hetzelfde te doen met deze macro?
PS: jouw code was veel verfijnder dan de mijne.
Hallo
Ja, het is mogelijk met de EditPart2-functie , maar pas op dat u de ModelDoc2, AssemblyDoc en Component2 niet door elkaar haalt.
Vriendelijke groeten
Hallo
Heb je iets waarmee ik het verschil tussen deze functies kan begrijpen?
Omdat mijn onderzoek te vaag is om er mijn weg in te vinden.
Hallo
Hier is een voorbeeld dat hetzelfde zou moeten doen als de macro die al is meegeleverd:
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
Vriendelijke groeten
Goedenavond
Ik heb net je code geprobeerd, maar ik laat Solidworks 2018 crashen.
Zonder me elementen te geven van waarom hij crashte.
Kunt u mij begeleiden?