Edit side and save part automatically via VBA

yvespilloy · November 14, 2017, 9:31am

Hello

I have a macro that replaces all the components of a model assembly with all the assemblies selected by the user via an Excel file, this allows us to build a machine composed of standard elements very quickly.

For one of these elements (a part), only one dimension will change depending on a few options selected by the user.

I could have made a solidworks part specific to each possibility but since this part will be specific to each machine, I preferred to make a generic model of this part then:

Import it into my machine model assembly
Open this generic part
Edit this rating
Save the part and its drawing under a new name (generic drawing already done)
and close this part to return to the assembly in construction.

Of all the steps mentioned above, I can only import my generic part (name of the part TEST. SLDPRT), select it, open it and then select the dimension in question which bears the name "DIAM", for the rest of the steps I thought I would use the macro recording to change the value of the selected dimension, save the part under a new name (as well as its drawing by opening it before saving the part file), Unfortunately the recording does not record anything for these actions...

I copy/paste the code I have to select my part, open it and select the dimension whose value I want to change:

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

So my question is rather obvious, does anyone have an idea for:

Change the value of a selected dimension
Open the drawing of a selected part
Save a part under a new name
Save the drawing under a new name
Close it all to go back to the assembly

I have already tried to search, to manipulate the selections but I must admit that I get very easily lost in the solidworks VBA compared to the Excel VBA and I therefore have difficulties to manipulate the selections etc...

Thank you in advance for your help

P.S: sorry for the lack of accents, I use an English keyboard ...

Yves

d.roger · November 14, 2017, 11:06am

Hello

It's done in a hurry so without the usual checks but it should be able to help you:

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

Kind regards

yvespilloy · November 14, 2017, 11:18am

Thank you very much d.roger it seems to work perfectly!

d.roger · November 14, 2017, 11:59am

Hello

You're welcome, if you like it, all you have to do is validate the answer.

Remember to do some security checks to avoid crashes (such as if it's a plan that is loaded then ..., if it's a part that is loaded then ..., etc)

Kind regards

yvespilloy · November 16, 2017, 2:01pm

Hello

I will quickly come back to this question.

I maintain that his code works exactly as I explained.

On the other hand, I have one last problem after that: the reference of the drawing remains the original part and not the new one.

The way I can think of to overcome this problem is to precede in this order:

- open 3D

- open 2D

- activate 3D

- modify 3D (dimension value)

- register 3D under the new name

- close 3D

- go back to the 2D (it should logically do it by itself since the 2D was the last document opened)

- save the 2D under the new name

- close the 2D

- normally we automatically return to the 3D of the assembly

In this order, because the part document is saved under the new name while its drawing is open, the drawing reference is automatically the new part document.

all I have to do now is know how to navigate between the different open documents and therefore activate the document (step in bold) after opening the 2D.

thank you in advance

Yves

d.roger · November 17, 2017, 2:58pm

Hello

In my opinion, this will not be enough because there may be traces of your original part in the view palette of your new plan. I'd rather do something like this:

- open 3D

- modify 3D (dimension value)

- register 3D under the new name

- open 2D

- replace the 3D model in the 2D plan views

- change the view palette of the 2D plan

- save the 2D under the new name

- close the 2D

- close 3D

- normally we automatically return to the 3D of the assembly

For the steps in bold you can use the following code:

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

Kind regards

d.roger · November 17, 2017, 4:38pm

If you want to navigate through the open SW windows, you can use the following code as a guide:

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

Kind regards