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
mb_entree.zip
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
3 „Gefällt mir“
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?
Hallo
Ich sehe keinen Grund, warum dieses Makro Sie zum Absturz von SW bringt, alle verwendeten Funktionen sind vor SW2018. Setzen Sie nummerierte MsgBoxen zwischen jeden Schritt, um zu sehen, bei welcher Funktion es abstürzt...
Herzliche Grüße
Hallo
Hier ist die Zeile, die Solidworks zum Absturz bringt:
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
Hallo
Zur Erinnerung: Die hier angegebenen Makros dienen nur als Beispiel und müssen überarbeitet werden, um zumindest eine Fehlerbehandlung hinzuzufügen...
Sie müssen also diese Fehlerbehandlung (siehe HIER) in der For-Schleife hinzufügen und diesen Fehler auf Wunsch im Argument swErrors (siehe HIER) der Funktion Save3 eskalieren.
Herzliche Grüße
Entschuldigung, aber es ist nicht die Zeile, die ich oben zitiert habe, die mich Solidworks zum Absturz bringt, ich habe nur einige Tests wiederholt und es ist letztendlich dieser:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Ich verstehe es jedoch nicht, weil es derselbe Code ist, der im vorherigen Makro funktioniert hat.
Und danke für Ihre Klarstellungen zu Save3, ich werde es mir ansehen.
Die Antwort ist so ziemlich die gleiche wie zuvor: Fügen Sie die Fehlerbehandlung ein und lesen Sie den Fehlertyp in der Variablen longstatus, siehe HIER für den möglichen Rückgabefehlertyp.
Hallo
Ich habe versucht, den Fehler zu behandeln, aber immer noch das gleiche Problem, dh Solidworks stürzt in der Zeile ab:
Set BoundingBox = swModel.FeatureManager.InsertGlobalBoundingBox(swGlobalBoundingBoxFitOptions_e.swBoundingBoxType_BestFit, False, False, longstatus)
Trotz der Fehlerbehandlung stürzt Solidworks ab, ohne die msgbox zu öffnen, gibt es ein Problem mit dem Code meiner Fehlerbehandlung, da die msgbox erscheinen sollte, wenn ein Fehler erkannt wird.
Es wird also kein Fehler erkannt, was kann also ein Problem sein?
Hier ist der Code mit Fehlerbehandlung:
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
Keine Meinung zu meiner Fehlerbehandlung, ist sie richtig oder gar nicht?
Vielen Dank im Voraus
Hallo @treza88
[HS Ein]
Kleine Frage aus reiner Neugier ;-)
Was nützt es Ihnen, einen Visualisierungswürfel für einen Raum zu haben und vor allem, was nützt es in einem ASM, für jeden Raum einen Visualisierungswürfel zu haben?
Ich persönlich benutze den Visualisierungswürfel nie.
[HS /Aus]
Herzliche Grüße