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
mb_entree.zip
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
3 likes
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?
Hallo
Ik zie geen enkele reden waarom deze macro je SW laat crashen, alle gebruikte functies zijn van vóór SW2018. Zet genummerde MsgBoxes tussen elke stap om te zien bij welke functie het crasht...
Vriendelijke groeten
Hallo
Dit is de regel die Solidworks laat crashen:
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
Hallo
Ter herinnering: de hier gegeven macro's zijn slechts bijvoorbeeld en moeten worden herwerkt om op zijn minst foutafhandeling toe te voegen...
U moet dus deze foutafhandeling (zie HIER) toevoegen aan de For-lus en deze fout escaleren, als u dat wilt, in het swErrors-argument (zie HIER) van de functie Save3 .
Vriendelijke groeten
Neem me niet kwalijk, maar het is niet de regel die ik hierboven heb geciteerd die me Solidworks doet crashen, ik heb net wat tests opnieuw gedaan en het is uiteindelijk deze:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Ik begrijp het echter niet, want het is dezelfde code die in de vorige macro werkte.
En bedankt voor je verduidelijkingen over Save3, ik zal ernaar kijken.
Het antwoord is vrijwel hetzelfde als eerder: vul de foutafhandeling in en lees het fouttype in de longstatus-variabele, zie HIER voor het mogelijke retourfouttype.
Hallo
Ik heb geprobeerd de fout op te lossen, maar nog steeds hetzelfde probleem, namelijk Solidworks crasht op de lijn:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Ondanks de foutafhandeling crasht Solidworks zonder de msgbox te openen, is er een probleem met de code van mijn foutafhandeling, omdat de msgbox zou moeten verschijnen als er een fout wordt gedetecteerd.
Er is dus geen fout gedetecteerd, dus wat kan een probleem zijn?
Hier is de code met foutafhandeling:
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
Hallo
Geen mening over mijn foutafhandeling, klopt het of klopt het helemaal niet?
Bij voorbaat dank
Hallo @treza88
[HS aan]
Kleine vraag uit pure nieuwsgierigheid ;-)
Wat heb je eraan om een visualisatiekubus voor een kamer te hebben en vooral wat is het nut van een ASM om voor elke kamer een visualisatiekubus te hebben.
Persoonlijk gebruik ik de visualisatiekubus nooit.
[HS /Uit]
Vriendelijke groeten