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
SolidworksApi/macros