AnsweredAssumed Answered

How to run macro in edited part file in assembly?

Question asked by Rainar Poleoluline on Jan 14, 2020

Hi gentlemen!

 

I built my first macro.
I've included a bit of my whole project in the attachment.
I have a whole staircase drawn out.
For a new project I use the pack and go method.
The length and pitch of the railing automatically change as the concrete in the staircase changes.
My macro works in the part file as I wish.

 

But ideally, I would like to:
open head assembly -> edit part -> run macro (assembly mode).
That way, I could adjust the railing attachments visually to the right places.

 

One thing I came up with is changing the following codes (adding : "@ Railing 2020 part-1 @ Railing 2020 assembly"

 

'Post 1 and leg 1
Boolstatus = swModel.Extension.SelectByID2 ("D9 @ Sketch2 @ Railing 2020 part-1 @ Railing 2020 assembly", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

 

But it doesn't work for every lines of code either.
And I wouldn't want to manually type the names of the files in the codes every time.

 

Would there be a good solution to my wish?

 

Attached are four files:

Railing 2020 part

Railings 2020 assembly

Railing_2020_configuration in PART mode

Railing_2020_configuration in ASSEMBLY mode

 

I use SW2019

 

 

Just in case I write my code behind the userform to here as well.

 

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swFeat As SldWorks.Feature
Dim Boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim swDispDim As SldWorks.DisplayDimension
Dim swSelMgr As SldWorks.SelectionMgr
Dim Posti1 As Double
Dim Jalg1 As Double
Dim Plaat1 As Double
Dim Ava1 As Double
Dim Posti2 As Double
Dim Jalg2 As Double
Dim Plaat2 As Double
Dim Ava2 As Double

 

            'Automatically returns the specified dimensions to the table.

Private Sub UserForm_Activate()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

 

            'Post 1 and leg 1
Boolstatus = swModel.Extension.SelectByID2("D9@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti1 = swDispDim.GetDimension2(0).Value
Posti1_Dim.Text = Posti1

Boolstatus = swModel.Extension.SelectByID2("D15@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg1 = swDispDim.GetDimension2(0).Value
Jalg1_Length.Text = Jalg1

 

            'Post 2 and leg 2
Boolstatus = swModel.Extension.SelectByID2("D8@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti2 = swDispDim.GetDimension2(0).Value
Posti2_Dim.Text = Posti2

Boolstatus = swModel.Extension.SelectByID2("D14@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg2 = swDispDim.GetDimension2(0).Value
Jalg2_Length.Text = Jalg2

End Sub

 

            'This block changes the handside of the railing

Private Sub ToggleButton1_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FeatureByName("Body-Move/Copy1")

If Me.ToggleButton1.Value = False Then
Me.ToggleButton1.Caption = "Left"
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
Else
Me.ToggleButton1.Caption = "Right"
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

Private Sub Close_button_Click()
'Ending macro
End
End Sub

 

            'To the left 1
Private Sub Vasakule1_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 6")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 7")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'To the center 1
Private Sub Keskel1_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FeatureByName("Body-Delete/Keep 5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 6")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 7")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'To the right 1
Private Sub Paremale1_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FeatureByName("Body-Delete/Keep 5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 6")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 7")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude5")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'To the left 2
Private Sub Vasakule2_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 2")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 3")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 4")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude1")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'To the center 2
Private Sub Keskel2_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FeatureByName("Body-Delete/Keep 2")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 3")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 4")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude1")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'To the right 2
Private Sub Paremale2_Click()

Set swApp = Application.SldWorks
Set swPart = swApp.ActiveDoc
Set swFeat = swPart.FeatureByName("Body-Delete/Keep 2")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 3")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Body-Delete/Keep 4")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swUnSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

Set swFeat = swPart.FeatureByName("Cut-Extrude1")

If Not swFeat Is Nothing Then
swFeat.SetSuppression2 swFeatureSuppressionAction_e.swSuppressFeature, swInConfigurationOpts_e.swThisConfiguration, ""
End If

End Sub

 

            'Add and refreshing the added values
Private Sub Refresh_Click()

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

Part.Parameter("D9@Sketch2").SystemValue = (Posti1_Dim.Value / 1000)
Part.Parameter("D15@Sketch2").SystemValue = (Jalg1_Length.Value / 1000)

Part.Parameter("D8@Sketch2").SystemValue = (Posti2_Dim.Value / 1000)
Part.Parameter("D14@Sketch2").SystemValue = (Jalg2_Length.Value / 1000)

Part.ForceRebuild

            'Bring already entered number to textbox after pressing refresh button

Boolstatus = swModel.Extension.SelectByID2("D9@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti1 = swDispDim.GetDimension2(0).Value
Posti1_Dim.Text = Posti1

Boolstatus = swModel.Extension.SelectByID2("D15@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg1 = swDispDim.GetDimension2(0).Value
Jalg1_Length.Text = Jalg1


Boolstatus = swModel.Extension.SelectByID2("D8@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti2 = swDispDim.GetDimension2(0).Value
Posti2_Dim.Text = Posti2

Boolstatus = swModel.Extension.SelectByID2("D14@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg2 = swDispDim.GetDimension2(0).Value
Jalg2_Length.Text = Jalg2

Part.ForceRebuild

End Sub

 

Private Sub CommandButton1_Click()

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

If Vasakule1.Value = True Then
Vasakule2.Value = True
End If

If Keskel1.Value = True Then
Keskel2.Value = True
End If

If Paremale1.Value = True Then
Paremale2.Value = True
End If

Part.Parameter("D15@Sketch2").SystemValue = (Jalg1_Length.Value / 1000)

Part.Parameter("D14@Sketch2").SystemValue = (Jalg1_Length.Value / 1000)

Part.ForceRebuild

            'Bring already entered number to textbox after pressing refresh button

Boolstatus = swModel.Extension.SelectByID2("D9@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti1 = swDispDim.GetDimension2(0).Value
Posti1_Dim.Text = Posti1

Boolstatus = swModel.Extension.SelectByID2("D15@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg1 = swDispDim.GetDimension2(0).Value
Jalg1_Length.Text = Jalg1


Boolstatus = swModel.Extension.SelectByID2("D8@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Posti2 = swDispDim.GetDimension2(0).Value
Posti2_Dim.Text = Posti2

Boolstatus = swModel.Extension.SelectByID2("D14@Sketch2", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)

Set swSelMgr = swModel.SelectionManager
Set swDispDim = swSelMgr.GetSelectedObject6(1, -1)

Jalg2 = swDispDim.GetDimension2(0).Value
Jalg2_Length.Text = Jalg2

Part.ForceRebuild

End Sub

Attachments

Outcomes