AnsweredAssumed Answered

Macro - Offset existing sketch, create extrude from sketch

Question asked by Ben Richardson on Feb 26, 2020
Latest reply on Feb 27, 2020 by Alex Burnett

Like • Show 0 Likes0
Comment • 4

I am trying to create a macro that will generate a part from a simple sketch. Nothing too complex, I have gotten it to work with the sketch that I recorded the macro with but when I try it on another part its not working as intended (particularly editing the sketch and adding the offset sketch)

Here is my code:

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
'Offset sketch
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditSketch
boolstatus = Part.Extension.SketchBoxSelect("-0.063401", "0.022647", "0.000000", "-0.063349", "0.022596", "0.000000")
boolstatus = Part.SketchManager.SketchOffset2(0.0022, False, False, 0, 0, True)
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

' Create Extrude
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, True, 0, 0, 0.016, 0.01, True, False, False, False, 4.36332312998583E-02, 4.36332312998583E-02, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
End Sub

I used "select all" but it seems to have created a box selection and I think this may be the issue.

What im trying to achieve:

From an already created sketch on the front plane, add 2.2mm offset outwards
Use this sketch to create extrude, 16mm long with 2.5 degrees draft

Once I get that working on ANY sketch, I then need to:

create sketch on the base face of the above extrude (can be front plane if the face is not suitable), offset 4mm outwards and 1mm inwards on that same face.
From this sketch create 1.2mm extrude
Create a set of configurations based off a list of sizes where "D1@Sketch1" is the dimension to be changed for each configuration

Im pretty new to macros so any help is appreciated, thanks.

No one else has this question

Outcomes

Alex Burnett Feb 26, 2020 10:07 AM

A recorded macro will almost only ever work for the specific scenario in which it was recorded for the part that it was recorded on. It takes some manipulation to get it to be more generalized.

Try this as a start. It still needs work but I got it functioning on my test part.

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swExtension As ModelDocExtension
Dim swSelMan As SelectionMgr
Dim selection As Object
Dim swFeatureMan As FeatureManager
Dim swSketchMan As SketchManager

Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swExtension = swModel.Extension
Set swSelMan = swModel.SelectionManager
Set swFeatureMan = swModel.FeatureManager
Set swSketchMan = swModel.SketchManager

Set selection = swSelMan.GetSelectedObject6(1, 0)

If selection Is Nothing Then
Exit Sub
End If

swModel.EditSketch
swExtension.SelectAll
swSketchMan.SketchOffset2 0.0022, False, False, 0, 0, True

swFeatureMan.FeatureExtrusion3 True, False, True, 0, 0, 0.016, 0.01, True, False, False, False, 4.36332312998583E-02, 4.36332312998583E-02, False, False, False, False, True, True, True, 0, 0, False

End Sub

Actions

Ben Richardson @ Alex Burnett on Feb 27, 2020 4:33 PM

Hi Alex,

Thanks for that! I tried it on a circle and worked, but i made a sketch with splines and it doesnt do anything!? I manually added the offset so it should work. Any reason why SelectAll might not like splines?

EDIT: Sketch must be selected for it to work! so never mind that!

I am trying to add a line so that it selects "Sketch1" as that will be the sketch name pretty much every time I use this macro.

.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

I get a compile error "expecting =", Ive added this line after "End if", sorry no idea what im doing!

Where is the best place to learn how to write these macros?

Actions

Alex Burnett @ Ben Richardson on Feb 27, 2020 4:59 PM

If you want to select it in the feature tree, I would rather to that by looking through the feature tree to see what is there and find it by name. I added an error checker to allow only part files.

As far as learning goes, google goes a long way in addition to trial and error.

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swExtension As ModelDocExtension
Dim swFeatureMan As FeatureManager
Dim swSketchMan As SketchManager
Dim curFeature As Feature
Dim Msg As String
Dim Style As Integer
Dim Title As String
Dim FeatureToFind As String
Dim found As Boolean

Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swExtension = swModel.Extension
Set swFeatureMan = swModel.FeatureManager
Set swSketchMan = swModel.SketchManager
found = False

FeatureToFind = "Sketch1" 'Rename this to the feature name you want to find

If swModel.GetType <> swDocPART Then
Msg = "Only Allowed on Part" ' Define message
Style = vbOKOnly ' OK Button only
Title = "Error" ' Define title
Call MsgBox(Msg, Style, Title) ' Display error message
Exit Sub ' Exit this program
End If

swModel.ClearSelection2 True

Set curFeature = swModel.FirstFeature()
Do While Not curFeature Is Nothing

If curFeature.Name = FeatureToFind And curFeature.GetTypeName = "ProfileFeature" Then
found = True
curFeature.Select2 False, 0
Exit Do
End If

Set curFeature = curFeature.GetNextFeature()

Loop

If found Then
swModel.EditSketch
swExtension.SelectAll
swSketchMan.SketchOffset2 0.0022, False, False, 0, 0, True

swFeatureMan.FeatureExtrusion3 True, False, True, 0, 0, 0.016, 0.01, True, False, False, False, 4.36332312998583E-02, 4.36332312998583E-02, False, False, False, False, True, True, True, 0, 0, False
Else
Msg = FeatureToFind & " Not Found."
Title = "Error"
Style = vbOKOnly
Call MsgBox(Msg, Style, Title)
Exit Sub
End If

End Sub

Actions

Ben Richardson @ Alex Burnett on Feb 28, 2020 1:00 AM

After some more playing around I am starting to realize to expect a macro to do this consistently without errors on any sketch is probably unrealistic.

Im thinking its probably best to do the sketching and offsets manually, its only a couple of steps. The main repetitive task that I think a macro could do well is from this model create configurations based off a list, for example i have a list of sizes and there is a single dimension (D1@Sketch 1) in the sketch that needs to be changed based on this list and a configuration created for it with that dimension and "mm" added as a prefix for the name.

Actions

4 Replies

Alex Burnett Feb 26, 2020 10:07 AM
Mark Correct
Correct Answer
A recorded macro will almost only ever work for the specific scenario in which it was recorded for the part that it was recorded on. It takes some manipulation to get it to be more generalized.

Try this as a start. It still needs work but I got it functioning on my test part.

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swExtension As ModelDocExtension
Dim swSelMan As SelectionMgr
Dim selection As Object
Dim swFeatureMan As FeatureManager
Dim swSketchMan As SketchManager

Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swExtension = swModel.Extension
Set swSelMan = swModel.SelectionManager
Set swFeatureMan = swModel.FeatureManager
Set swSketchMan = swModel.SketchManager
Set selection = swSelMan.GetSelectedObject6(1, 0)

If selection Is Nothing Then
Exit Sub
End If

swModel.EditSketch
swExtension.SelectAll
swSketchMan.SketchOffset2 0.0022, False, False, 0, 0, True
swFeatureMan.FeatureExtrusion3 True, False, True, 0, 0, 0.016, 0.01, True, False, False, False, 4.36332312998583E-02, 4.36332312998583E-02, False, False, False, False, True, True, True, 0, 0, False
End Sub
Like • Show 1 Like1
Actions
- Ben Richardson @ Alex Burnett on Feb 27, 2020 4:33 PM
  Mark Correct
  Correct Answer
  Hi Alex,
  Thanks for that! I tried it on a circle and worked, but i made a sketch with splines and it doesnt do anything!? I manually added the offset so it should work. Any reason why SelectAll might not like splines?
  
  EDIT: Sketch must be selected for it to work! so never mind that!
  
  I am trying to add a line so that it selects "Sketch1" as that will be the sketch name pretty much every time I use this macro.
  
  .Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
  I get a compile error "expecting =", Ive added this line after "End if", sorry no idea what im doing!
  
  Where is the best place to learn how to write these macros?
  Like • Show 0 Likes0
  Actions
  - Alex Burnett @ Ben Richardson on Feb 27, 2020 4:59 PM
    Mark Correct
    Correct Answer
    If you want to select it in the feature tree, I would rather to that by looking through the feature tree to see what is there and find it by name. I added an error checker to allow only part files.
    
    As far as learning goes, google goes a long way in addition to trial and error.
    
    Option Explicit
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    Dim swExtension As ModelDocExtension
    Dim swFeatureMan As FeatureManager
    Dim swSketchMan As SketchManager
    Dim curFeature As Feature
    Dim Msg As String
    Dim Style As Integer
    Dim Title As String
    Dim FeatureToFind As String
    Dim found As Boolean
    
    Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swExtension = swModel.Extension
    Set swFeatureMan = swModel.FeatureManager
    Set swSketchMan = swModel.SketchManager
    found = False
    FeatureToFind = "Sketch1" 'Rename this to the feature name you want to find
    If swModel.GetType <> swDocPART Then
    Msg = "Only Allowed on Part" ' Define message
    Style = vbOKOnly ' OK Button only
    Title = "Error" ' Define title
    Call MsgBox(Msg, Style, Title) ' Display error message
    Exit Sub ' Exit this program
    End If
    swModel.ClearSelection2 True
    Set curFeature = swModel.FirstFeature()
    Do While Not curFeature Is Nothing
    If curFeature.Name = FeatureToFind And curFeature.GetTypeName = "ProfileFeature" Then
    found = True
    curFeature.Select2 False, 0
    Exit Do
    End If
    
    Set curFeature = curFeature.GetNextFeature()
    
    Loop
    
    If found Then
    swModel.EditSketch
    swExtension.SelectAll
    swSketchMan.SketchOffset2 0.0022, False, False, 0, 0, True
    
    swFeatureMan.FeatureExtrusion3 True, False, True, 0, 0, 0.016, 0.01, True, False, False, False, 4.36332312998583E-02, 4.36332312998583E-02, False, False, False, False, True, True, True, 0, 0, False
    Else
    Msg = FeatureToFind & " Not Found."
    Title = "Error"
    Style = vbOKOnly
    Call MsgBox(Msg, Style, Title)
    Exit Sub
    End If
    End Sub
    Like • Show 1 Like1
    Actions
    - Ben Richardson @ Alex Burnett on Feb 28, 2020 1:00 AM
      Mark Correct
      Correct Answer
      After some more playing around I am starting to realize to expect a macro to do this consistently without errors on any sketch is probably unrealistic.
      
      Im thinking its probably best to do the sketching and offsets manually, its only a couple of steps. The main repetitive task that I think a macro could do well is from this model create configurations based off a list, for example i have a list of sizes and there is a single dimension (D1@Sketch 1) in the sketch that needs to be changed based on this list and a configuration created for it with that dimension and "mm" added as a prefix for the name.
      Like • Show 0 Likes0
      Actions

Macro - Offset existing sketch, create extrude from sketch

Outcomes

Related Content

Recommended Content