Zijde bewerken en onderdeel automatisch opslaan via VBA

yvespilloy · 14 november 2017 om 09:31

Hallo

Ik heb een macro die alle componenten van een modelassemblage vervangt door alle assemblages die door de gebruiker zijn geselecteerd via een Excel-bestand, dit stelt ons in staat om zeer snel een machine te bouwen die is samengesteld uit standaardelementen.

Voor een van deze elementen (een onderdeel) verandert slechts één dimensie, afhankelijk van een paar opties die door de gebruiker zijn geselecteerd.

Ik had een solidworks-onderdeel kunnen maken dat specifiek is voor elke mogelijkheid, maar aangezien dit onderdeel specifiek is voor elke machine, heb ik er de voorkeur aan gegeven om een generiek model van dit onderdeel te maken:

Importeer het in mijn machinemodelassemblage
Open dit algemene deel
Bewerk deze beoordeling
Sla het onderdeel en de tekening op onder een nieuwe naam (generieke tekening is al gedaan)
en sluit dit onderdeel om terug te keren naar de assemblage in aanbouw.

Van alle hierboven genoemde stappen kan ik alleen mijn generieke onderdeel importeren (naam van het onderdeel TEST. SLDPRT), selecteer het, open het en selecteer vervolgens de betreffende dimensie die de naam "DIAM" draagt, voor de rest van de stappen dacht ik dat ik de macro-opname zou gebruiken om de waarde van de geselecteerde dimensie te wijzigen, het onderdeel onder een nieuwe naam op te slaan (evenals de tekening door het te openen voordat het onderdeelbestand wordt opgeslagen), Helaas registreert de opname niets voor deze acties...

Ik kopieer/plak de code die ik heb om mijn onderdeel te selecteren, open het en selecteer de dimensie waarvan ik de waarde wil wijzigen:

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

Dus mijn vraag is nogal voor de hand liggend, heeft iemand een idee voor:

De waarde van een geselecteerde dimensie wijzigen
Open de tekening van een geselecteerd onderdeel
Sla een onderdeel op onder een nieuwe naam
Sla de tekening op onder een nieuwe naam
Sluit alles om terug te gaan naar de montage

Ik heb al geprobeerd te zoeken, de selecties te manipuleren, maar ik moet toegeven dat ik heel gemakkelijk verdwaal in de solidworks VBA in vergelijking met de Excel VBA en ik heb daarom moeite om de selecties te manipuleren enz...

Bij voorbaat dank voor uw hulp

P.S: sorry voor het ontbreken van accenten, ik gebruik een Engels toetsenbord ...

Yves

d_roger · 14 november 2017 om 11:06

Hallo

Het is haastig gedaan, dus zonder de gebruikelijke controles, maar het zou u moeten kunnen helpen:

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

Vriendelijke groeten

yvespilloy · 14 november 2017 om 11:18

Heel erg bedankt d.roger het lijkt perfect te werken!

d_roger · 14 november 2017 om 11:59

Hallo

Graag gedaan, als het je bevalt, hoef je alleen maar het antwoord te valideren.

Vergeet niet om enkele beveiligingscontroles uit te voeren om crashes te voorkomen (bijvoorbeeld als het een plan is dat wordt geladen, dan ..., als het een onderdeel is dat is geladen, dan ..., enz.)

Vriendelijke groeten

yvespilloy · 16 november 2017 om 14:01

Hallo

Ik kom snel op deze vraag terug.

Ik blijf erbij dat zijn code precies werkt zoals ik heb uitgelegd.

Aan de andere kant heb ik daarna nog een laatste probleem: de referentie van de tekening blijft het originele deel en niet het nieuwe.

De manier die ik kan bedenken om dit probleem op te lossen, is door in deze volgorde vooraf te gaan:

- 3D openen

- open 2D

- activeer 3D

- 3D wijzigen (dimensiewaarde)

- 3D registreren onder de nieuwe naam

- 3D sluiten

- ga terug naar de 2D (het zou het logischerwijs zelf moeten doen, aangezien de 2D het laatste geopende document was)

- sla de 2D op onder de nieuwe naam

- sluit de 2D

- normaal gesproken keren we automatisch terug naar de 3D van de assemblage

In deze volgorde, omdat het artikeldocument onder de nieuwe naam wordt opgeslagen terwijl de tekening is geopend, is de tekeningreferentie automatisch het nieuwe artikeldocument.

het enige wat ik nu nog moet doen is weten hoe ik tussen de verschillende geopende documenten moet navigeren en dus het document activeren (stap vetgedrukt) na het openen van de 2D.

Bij voorbaat dank

Yves

d_roger · 17 november 2017 om 14:58

Hallo

Naar mijn mening zal dit niet genoeg zijn omdat er sporen van uw originele onderdeel kunnen zijn in het weergavepalet van uw nieuwe plan. Ik zou liever iets als dit doen:

- 3D openen

- 3D wijzigen (dimensiewaarde)

- 3D registreren onder de nieuwe naam

- open 2D

- vervang het 3D-model in de 2D-planaanzichten

- het weergavepalet van het 2D-plan wijzigen

- sla de 2D op onder de nieuwe naam

- sluit de 2D

- 3D sluiten

- normaal gesproken keren we automatisch terug naar de 3D van de assemblage

Voor de vetgedrukte stappen kunt u de volgende code gebruiken:

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

Vriendelijke groeten

d_roger · 17 november 2017 om 16:38

Als u door de geopende SW-vensters wilt navigeren, kunt u de volgende code als richtlijn gebruiken:

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

Vriendelijke groeten