Modifier cote puis enregistrer piece automatiquement via VBA

yvespilloy · Novembre 14, 2017, 9:31

Bonjour,

J'ai une macro qui remplace tous les composants d'un assemblage modele par l'ensemble des assemblages selectionnes par l'utilisateur via un fichier Excel, ca nous permet de contruire une machine composee d'elements standards tres rapidement.

Pour une de ces elements (une piece), seule une cote va changer dependant de quelques options selectionnees par l'utilisateur.

J'aurai pu faire une piece solidworks specifique a chaque possibilite mais vue que cette piece sera propre a chaque machine, j'ai prefere faire un model generique de cette piece puis:

l'importer dans mon assemblage model de machine
ouvrire cette piece generique
modifier cette cote
enregistrer la piece ainsi que sa mise en plan sous un nouveau nom (mise en plan generique deja faite)
et refermer cette piece pour revenir a l'assemblage en contruction.

De toute les etapes citees ci-dessus je n'arrive qu'a importer ma piece generique (nom de la piece TEST.SLDPRT), la selectionner, l'ouvrir puis selectionner la cote en question qui porte le nom "DIAM", pour le reste des etapes je pensais utiliser l’enregistrement de macro pour modifier la valeur de la cote selectionnee, enregistrer la pieces sous un nouveau nom (ainsi que sa mise en plan en l’ouvrant avant l’enregistrement du fichier piece), malheureusement l’enregistrement n’enregistre rien pour ces actions…

Je copie/colle le code que j’ai pour selectionner ma piece, l’ouvrir et la selection de la cote dont je veux changer la valeur:

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

Ma question est donc plutot evidente, est ce que quelqu’un a une idee pour :

Modifier la valeur d’une cote selectionnee
Ouvrir la mise en plan d’une piece selectionnee
Enregistrer une piece sous un nouveau nom
Enregistrer la mise en plans sous un nouveau nom
Refermer tout ca pour retourner sur l’assemblage

J’ai deja essaye de chercher, de manipuler les selection mais je dois avouer que je me perds tres facilement dans le VBA solidworks comparer au VBA Excel et j’ai donc des difficultees a manipuler les selections etc…

Merci d’avance pour votre aide

P.S : desole pour le manqué d’accents, j’utilise un clavier Anglais …

Yves

d.roger · Novembre 14, 2017, 11:06

Bonjour,

C'est fait à la va vite donc sans les vérifications d'usage mais ça doit pouvoir t'aider :

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

Cordialement,

yvespilloy · Novembre 14, 2017, 11:18

Merci beaucoup d.roger ca a l'air de marcher nickel!

d.roger · Novembre 14, 2017, 11:59

Bonjour,

De rien, si cela te convient il ne reste plus qu'à valider la réponse.

Penses à faire quelques vérifications de sécurité pour éviter les plantages (du type si c'est bien un plan qui est chargé alors ..., si c'est bien une pièce qui est chargée alors ..., etc)

Cordialement,

yvespilloy · Novembre 16, 2017, 2:01

Bonjour,

Je reviens rapidement sur cet question.

Je maintient que son code marche excatement comme je l'avais expliquer.

en revanche il me reste un dernier probleme apres ca: la reference de la mise en plan reste la piece d'origine et non la nouvelle.

le moyen auquel je pense pour palier a ce probleme est de preceder dans cet order:

- ouvrir 3D

- ouvrir 2D

- activer 3D

- modifier 3D (valeur de la cote)

- enregistrer 3D sous le nouveau nom

- fermer 3D

- revenir sur le 2D (ce devrait logiquement le faire tout seul vu que le 2D etait le dernier document ouver)

- enregistrer le 2D sous le nouveau nom

- fermer le 2D

- normalement on revient automatiquement au 3D de l'assemblage

Dans cet ordre, vu que le document piece est enregistrer sous le nouveau nom alors que sa mise en plan est ouverte, la reference de la mise en plan est automatiquement le nouveau document piece.

il ne me reste plus qu'a savoir comment naviger entre les differents documents ouverts et donc activer le document piece (etape en gras) apres l'ouverture du 2D.

merci d'avance

Yves

d.roger · Novembre 17, 2017, 2:58

Bonjour,

Cela ne sera à mon avis pas suffisant car il risque de rester des traces de ta pièce d'origine dans la palette de vue de ton nouveau plan. Moi je ferais plutôt quelque chose du genre :

- ouvrir 3D

- modifier 3D (valeur de la cote)

- enregistrer 3D sous le nouveau nom

- ouvrir 2D

- remplacer le modèle 3D dans les vues du plan 2D

- modifier la palette de vue du plan 2D

- enregistrer le 2D sous le nouveau nom

- fermer le 2D

- fermer 3D

- normalement on revient automatiquement au 3D de l'assemblage

Pour les étapes en gras tu peux t'aider du code suivant :

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

Cordialement,

d.roger · Novembre 17, 2017, 4:38

Si tu veux naviguer dans les fenêtres SW ouvertes tu peux t'inspirer du code suivant :

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

Cordialement,