Seite bearbeiten und Teil automatisch über VBA speichern

yvespilloy · 14. November 2017 um 09:31

Hallo

Ich habe ein Makro, das alle Komponenten einer Modellbaugruppe durch alle vom Benutzer über eine Excel-Datei ausgewählten Baugruppen ersetzt, dies ermöglicht es uns, sehr schnell eine Maschine zu erstellen, die aus Standardelementen besteht.

Für eines dieser Elemente (ein Teil) ändert sich nur eine Dimension, abhängig von einigen Optionen, die der Benutzer ausgewählt hat.

Ich hätte ein Solidworks-Teil speziell für jede Möglichkeit erstellen können, aber da dieses Teil für jede Maschine spezifisch ist, habe ich es vorgezogen, ein generisches Modell dieses Teils zu erstellen:

Importieren Sie es in meine Maschinenmodellbaugruppe
Öffnen Sie dieses generische Bauteil
Diese Bewertung bearbeiten
Speichern Sie das Teil und seine Zeichnung unter einem neuen Namen (generische Zeichnung bereits fertig)
und schließen Sie dieses Teil, um zur Baugruppe in der Konstruktion zurückzukehren.

Von allen oben genannten Schritten kann ich nur mein generisches Teil (Name des Teils TEST. SLDPRT), wählen Sie es aus, öffnen Sie es und wählen Sie dann die betreffende Dimension aus, die den Namen "DIAM" trägt, für den Rest der Schritte dachte ich, ich würde die Makroaufzeichnung verwenden, um den Wert der ausgewählten Dimension zu ändern, das Teil unter einem neuen Namen zu speichern (sowie seine Zeichnung, indem Sie es vor dem Speichern der Teiledatei öffnen), Leider wird in der Aufzeichnung für diese Aktionen nichts aufgezeichnet...

Ich kopiere / füge den Code ein, den ich habe, um mein Teil auszuwählen, öffne es und wähle die Dimension aus , deren Wert ich ändern möchte:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("TEST-1@ASSY TEST", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.OpenCompFile

' Open the part TEST.SLDPRT 
Set Part = swApp.OpenDoc6("PATCH\TEST.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc

' Select dimension "DIAM"
boolstatus = Part.Extension.SelectByID2("DIAM@Sketch1@TEST.SLDPRT", "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)

End Sub

Meine Frage ist also ziemlich offensichtlich, hat jemand eine Idee für:

Ändern des Werts einer ausgewählten Dimension
Öffnen der Zeichnung eines ausgewählten Teils
Speichern eines Teils unter einem neuen Namen
Speichern Sie die Zeichnung unter einem neuen Namen
Schließen Sie alles, um zur Baugruppe zurückzukehren

Ich habe bereits versucht zu suchen, die Auswahl zu manipulieren, aber ich muss zugeben, dass ich mich im Vergleich zu Excel VBA sehr leicht in Solidworks VBA verliere und daher Schwierigkeiten habe, die Auswahl usw. zu manipulieren.

Vielen Dank im Voraus für Ihre Hilfe

P.S: Entschuldigung für die fehlenden Akzente, ich benutze eine englische Tastatur ...

Yves

d.roger · 14. November 2017 um 11:06

Hallo

Es wird in Eile gemacht, also ohne die üblichen Überprüfungen, aber es sollte Ihnen helfen können:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

boolstatus = Part.Extension.SelectByID2("TEST-1@ASSY TEST", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Part.OpenCompFile

' Open the part TEST.SLDPRT
Set Part = swApp.OpenDoc6("PATCH\TEST.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc

' Select dimension "DIAM"
boolstatut = Part.Extension.SelectByID2("DIAM@Sketch1@TEST.SLDPRT", "DIMENSION", 0, 0, 0, True, 0, Nothing, 0)

' On change la valeur de la cote
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim dimValue As Variant
Dim newDimValue As String
newDimValue = "50"
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = Part.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject5(1)
Set swDim = swDispDim.GetDimension
dimValue = swDim.SetValue3(newDimValue, swThisConfiguration, "")
Part.ForceRebuild

'on récupére l'emplacement du fichier
Dim stPath As String
stPath = Part.GetPathName
'on récupére le nombre de caractére jusqu'au . de l'extension
lgFichier = InStrRev(stPath, ".", -1, vbTextCompare) - 1
'on récupére le chemin sans l'extention
If lgFichier > 0 Then
      stPath = Left(stPath, lgFichier)
End If

' On ouvre le plan TEST.SLDDRW
Set Part = swApp.OpenDoc6(stPath & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Part.ForceRebuild
Dim newNameDRW As String
newNameDRW = stPath & "-2.SLDDRW"
boolstatut = Part.SaveAs3(newNameDRW, 0, 0)
' On ferme le plan
swApp.CloseDoc (newNameDRW)

' On active la pièce
Set Part = swApp.ActiveDoc
Dim newNamePRT As String
newNamePRT = stPath & "-2.SLDPRT"
boolstatut = Part.SaveAs3(newNamePRT, 0, 0)
' On ferme la pièce
swApp.CloseDoc (newNamePRT)

End Sub

Herzliche Grüße

yvespilloy · 14. November 2017 um 11:18

Vielen Dank d.roger es scheint perfekt zu funktionieren!

d.roger · 14. November 2017 um 11:59

Hallo

Gern geschehen, wenn es Ihnen gefällt, müssen Sie nur die Antwort validieren.

Denken Sie daran, einige Sicherheitsüberprüfungen durchzuführen, um Abstürze zu vermeiden (z. B. wenn es sich um einen Plan handelt, der geladen wird, dann ..., wenn es sich um einen Teil handelt, der geladen wird, dann ..., usw.)

Herzliche Grüße

yvespilloy · 16. November 2017 um 14:01

Hallo

Ich komme schnell auf diese Frage zurück.

Ich behaupte, dass sein Code genau so funktioniert, wie ich es erklärt habe.

Auf der anderen Seite habe ich danach noch ein letztes Problem: Die Referenz der Zeichnung bleibt das ursprüngliche Teil und nicht das neue.

Der Weg, den ich mir vorstellen kann, um dieses Problem zu lösen, besteht darin, in dieser Reihenfolge voranzugehen:

- 3D öffnen

- 2D öffnen

- 3D aktivieren

- 3D (Bemaßungswert) ändern

- 3D unter dem neuen Namen registrieren

- schließen 3D

- Gehen Sie zurück zur 2D (es sollte dies logischerweise von selbst tun, da die 2D das letzte geöffnete Dokument war)

- Speichern Sie das 2D unter dem neuen Namen

- Schließen Sie das 2D

- normalerweise kehren wir automatisch in die 3D der Baugruppe zurück

Da das Teiledokument in dieser Reihenfolge unter dem neuen Namen gespeichert wird, während die Zeichnung geöffnet ist, ist die Zeichnungsreferenz automatisch das neue Teiledokument.

Alles, was ich jetzt tun muss, ist zu wissen, wie ich zwischen den verschiedenen geöffneten Dokumenten navigieren kann und daher das Dokument nach dem Öffnen des 2D zu aktivieren (Schritt in Fettdruck).

Vielen Dank im Voraus

Yves

d.roger · 17. November 2017 um 14:58

Hallo

Meiner Meinung nach wird dies nicht ausreichen, da sich in der Ansichtspalette Ihres neuen Plans möglicherweise Spuren Ihres ursprünglichen Teils befinden. Ich würde lieber so etwas machen:

- 3D öffnen

- 3D (Bemaßungswert) ändern

- 3D unter dem neuen Namen registrieren

- 2D öffnen

- Ersetzen Sie das 3D-Modell in den 2D-Draufsichten

- Ändern Sie die Ansichtspalette des 2D-Plans

- Speichern Sie das 2D unter dem neuen Namen

- Schließen Sie das 2D

- schließen 3D

- normalerweise kehren wir automatisch in die 3D der Baugruppe zurück

Für die fett formatierten Schritte können Sie den folgenden Code verwenden:

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swDrawingDoc As SldWorks.DrawingDoc
Dim swSelectionMgr As SldWorks.SelectionMgr
Dim swDrawingComponent As SldWorks.DrawingComponent
Dim views(0) As Object
Dim swView As SldWorks.View
Dim instances(0) As Object
Dim status As Boolean

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawingDoc = swModel
    status = swModel.ActivateView("Vue de mise en plan1")

    Set swModelDocExt = swModel.Extension
    status = swModelDocExt.SelectByID2("Vue de mise en plan1", "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
    Set swSelectionMgr = swModel.SelectionManager
    Set swView = swSelectionMgr.GetSelectedObject6(1, -1)
    Set views(0) = swView

    status = swModelDocExt.SelectByID2("TEST@Vue de mise en plan1", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    Set swDrawingComponent = swSelectionMgr.GetSelectedObject6(1, -1)
    Set instances(0) = swDrawingComponent.Component
    status = swDrawingDoc.ReplaceViewModel(newNamePRT, (views), (instances))
    
    swDrawingDoc.GenerateViewPaletteViews (newNamePRT)
End Sub

Herzliche Grüße

d.roger · 17. November 2017 um 16:38

Wenn Sie durch die geöffneten SW-Fenster navigieren möchten, können Sie den folgenden Code als Leitfaden verwenden:

Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swFrame As SldWorks.Frame
Dim swModelWindow As SldWorks.ModelWindow
Dim modelWindows As Variant
Dim obj As Variant
Dim errors As Long
Dim warnings As Long
Dim HWnd As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swFrame = swApp.Frame
    modelWindows = swFrame.modelWindows
    For Each obj In modelWindows
        Set swModelWindow = obj
        Set swModelDoc = swModelWindow.ModelDoc
        Set swModelDoc = Nothing
        swFrame.ShowModelWindow swModelWindow
        HWnd = swModelWindow.HWnd
        Debug.Print ("  Model window handle: " & HWnd)
        Debug.Print ("  Model title as it seen in the model's window's title bar: " & swModelWindow.Title)
        If swModelWindow.Title = "Pièce12.SLDPRT" Then
            Exit For
        End If
    Next obj
End Sub

Herzliche Grüße