Hallo an alle
Ist es in einer Baugruppe möglich, einen Visualisierungswürfel für alle Teile zu erstellen, die in derselben Baugruppe vorhanden sind?
weil ich den Eindruck habe, dass man jedes Stück bearbeiten muss, um den Würfel zu erstellen.
Gibt es eine Möglichkeit, dies zu tun oder durch eine VBA-Schleife die Erstellung eines Visualisierungswürfels für jeden Raum zu automatisieren?
Vielen Dank im Voraus.
Hallo
Um es auf den Teilen zu erstellen, sowohl per Makro als auch manuell, müssen Sie jedes Teil bearbeiten.
Aber es ist schneller und einfacher per Makro, da es mit einem Klick erledigt ist.
Herzliche Grüße
Hallo und vielen Dank d.roger für Ihre Intervention,
Ich programmiere in VBA für Excel, aber VBA für Solidworks ist ein Problem für mich.
Ich habe versucht, einen Code zu ändern, der alle Teile einer Baugruppe öffnet, und den Visualisierungswürfel bei jedem Öffnen zu erstellen, aber es wird kein Würfel für mich erstellt.
Und ich sehe nicht, wo es falsch ist.
Für den Fall, dass ich das Makro setze, wenn jemand sieht, wo das Problem liegt.
Sie erstellen den Würfel in der Variablen Part mit der Zeile "Set BoundingBox = Part. FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)", mit der Ausnahme, dass die Variable "Part" an Ihre Assembly angefügt ist, da es sich am Anfang um "swApp.ActiveDoc" handelt, sodass der Cube beim Starten Ihres Makros in der Assembly erstellt wird. Sie müssen Ihren Würfel auf der Variablen "swModel" erstellen, die der Teil ist, den Sie durch die Aktion der Zeile "Set swModel = swApp.ActivateDoc(Document)" öffnen , so dass eine erste Änderung darin besteht, zumindest die Zeilen wie folgt zu korrigieren:
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
Dieses Makro wird dann funktionsfähig...
Herzliche Grüße
Wie bei der anderen Diskussion:
Und setzen Sie Ihre Münzen in den gelösten Modus, sonst funktioniert es nicht...
Herzliche Grüße
Vielen Dank für diesen ersten Schritt, auf der anderen Seite habe ich 7 Teile in meiner Baugruppe und es gibt nur 4 Teile, die einen Visualisierungswürfel haben, die letzten 3 nicht.
Es muss ein Problem in der Schleife geben , dass nicht alle Teile berücksichtigt werden?
Tut mir leid, aber was ist der gelöste Modus, entschuldigen Sie meine Unwissenheit.
Beim Laden einer Baugruppe in Solidworks ist es möglich, die Teile entweder im aufgelösten oder im hellen Modus zu öffnen, der Unterschied besteht darin, dass die Teile entweder tatsächlich geöffnet sind oder nur eine grafische Visualisierung davon auf dem Bildschirm angezeigt wird. Siehe HIER für die Vorteile des aufgelösten Modus und HIER für leichte Teile.
Klicken Sie also mit der rechten Maustaste auf die Baugruppe, wählen Sie im Kontextmenü "Lightweight Parts to Resolved" und versuchen Sie dann Ihr Makro erneut.
Herzliche Grüße
Ok, danke für die Klarstellungen.
Und ich war gut in der Auflösung und ich habe immer noch nur 4 von 7 Stücken, die einen Visualisierungswürfel haben.
Wenn ich das geänderte Makro für eine größere Baugruppe starte, werden alle Visualisierungswürfel erstellt. Haben Sie keine Oberflächenteile? und welche Version von SW?
Nein, ich habe keine Oberflächenteile und meine Version ist eine 2018
Ich habe gerade wieder ein paar Tests gemacht und immer noch das Gleiche, hier ist meine Montage, wenn Sie einige Tests durchführen möchten
Ich habe einen Test an einer anderen Baugruppe mit 7 Teilen gemacht und da funktioniert es, ich weiß nicht, warum es mit dieser nicht funktioniert.
Vielleicht siehst du ja etwas auf deiner Seite.
Können Sie mir sagen, ob dieser Code mit symmetrischen Teilen oder mit einer Komponentenwiederholung funktioniert?
Ich werde auf meiner Seite einige Tests durchführen, um das zu überprüfen, aber ich bin an Ihrer Meinung interessiert
Ich erhalte den Visualisierungswürfel für alle Teile Ihrer Baugruppe.
Ich habe den Code wie folgt geändert, um eine ganze Reihe von Zeilen zu entfernen, die wahrscheinlich keinen Zweck erfüllen:
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, danke für Ihr Feedback, also verstehe ich nicht, warum ich zu Hause Probleme habe, aber vielleicht habe ich später eine Erklärung.
Vielen Dank für Ihre Bereinigung des Codes, ich habe auch auf meiner Seite daran gearbeitet, das zu entfernen, was nicht nützlich ist, aber ich werde mit Ihnen vergleichen.
In der Zwischenzeit ein großes Dankeschön für Ihre Hilfe.
Wenn ich ein Problem habe, komme ich in der Zwischenzeit auf den Thread zurück, ich werde deinen letzten Beitrag bestätigen
Eine weitere Frage, die mich stört, wir öffnen alle Teile, aber in einer Baugruppe können wir bearbeiten, ohne sie zu öffnen, und das spart Zeit.
Ist es möglich, das Gleiche mit diesem Makro zu tun?
PS: Ihr Code war viel raffinierter als meiner.
Hallo
Ja, mit der Funktion EditPart2 ist das möglich, aber achten Sie darauf, dass Sie nicht zwischen ModelDoc2, AssemblyDoc und Component2 verwechselt werden.
Herzliche Grüße
Hallo
Haben Sie etwas, das es mir ermöglicht, den Unterschied zwischen diesen Funktionen zu verstehen?
Denn meine Recherchen sind zu vage, um mich zurechtzufinden.
Hallo
Hier ist ein Beispiel, das das Gleiche tun sollte wie das bereits bereitgestellte Makro:
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
Herzliche Grüße
Guten Abend
Ich habe gerade Ihren Code ausprobiert, aber er bringt mich zum Absturz von Solidworks 2018.
Ohne mir irgendwelche Elemente zu nennen, warum er gestürzt ist.
Können Sie mich anleiten?