Create Linear Pattern Example (VBA)
This example shows how to create a linear-pattern feature using preselected
direction features, preselected pattern seed features, and
variable spacing between
pattern instances.
'----------------------------------------------------------------------------
' Preconditions: Open install_dir\samples\tutorial\api\varyinstance.sldprt.
'
' Postconditions: A linear-pattern feature is created.
'
' NOTE: Because the model is used elsewhere, do not
' save any changes when closing it.
'--------------------------------------------------------------
Dim SwApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long
Option Explicit
Sub main()
Set SwApp = Application.SldWorks
SwApp.ActivateDoc3 "varyInstance",
False, swUserDecision, longstatus
Set Part = SwApp.ActiveDoc
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Cut-Extrude1",
"BODYFEATURE", 7.74979914490359E-03, 3.64333445241982E-03,
-3.54413541641527E-02, False, 4, Nothing, 0)
If boolstatus = False Then ErrorMsg SwApp, "Failed to select
a seed feature": GoTo LastLine
boolstatus = Part.Extension.SelectByID2("",
"EDGE", -5.99771410065841E-05, 6.88469352660661E-02, -4.02202172175059E-02,
True, 1, Nothing, 0)
If boolstatus = False Then ErrorMsg SwApp, "Failed to select
an edge for direction 1": GoTo LastLine
boolstatus = Part.Extension.SelectByID2("Fillet1",
"BODYFEATURE", 8.29480066556698E-04, 4.5558314310199E-03, -3.52439589983078E-02,
True, 4, Nothing, 0)
If boolstatus = False Then ErrorMsg SwApp, "Failed to select
a seed feature": GoTo LastLine
boolstatus = Part.Extension.SelectByID2("",
"EDGE", -4.73572225700991E-06, -4.01494819566892E-02, -4.90816550993962E-02,
True, 2, Nothing, 0)
If boolstatus = False Then ErrorMsg SwApp, "Failed to select
an edge for direction 2": GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("D1@Sketch2@varyInstance.SLDPRT",
2, 1, 0, 0.003)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to dimension D1@Sketch2@varyInstance.SLDPRT in direction 1":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("D1@Cut-Extrude1@varyInstance.SLDPRT",
2, 1, 0, -0.001)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to dimension D1@Cut-Extrude1@varyInstance.SLDPRT in direction
1": GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("Space
Increment", 2, 2, 0, 0.01)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to direction 1 spacing": GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("D1@Sketch2@varyInstance.SLDPRT",
2, 1, 1, 0.004)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to dimension D1@Sketch2@varyInstance.SLDPRT in direction 2":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("D1@Fillet1@varyInstance.SLDPRT",
2, 1, 1, 0.0001)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to dimension D1@Fillet1@varyInstance.SLDPRT in direction 2":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceIncrement("Space
Increment", 2, 2, 1, 0.015)
If boolstatus = False Then ErrorMsg SwApp, "Failed to add an
increment value to direction 2 spacing": GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceOverride("D1@Sketch2@varyInstance.SLDPRT",
2, 1, -1, 4, 1, 0.05)
If boolstatus = False Then ErrorMsg SwApp, "Failed to
override value of dimension D1@Sketch2@varyInstance.SLDPRT at instance (4, 1)":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceOverride("D1@Fillet1@varyInstance.SLDPRT",
2, 1, -1, 4, 1, 0.005)
If boolstatus = False Then ErrorMsg SwApp, "Failed to
override value of dimension D1@Fillet1@varyInstance.SLDPRT at instance (4, 1)":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceOverride("D1@Fillet1@varyInstance.SLDPRT",
2, 1, -1, 2, 3, 0.004)
If boolstatus = False Then ErrorMsg SwApp, "Failed to
override value of dimension D1@Fillet1@varyInstance.SLDPRT at instance (2, 3)":
GoTo LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceOverride("Space
Increment", 2, 2, 0, 4, 1, 0.13)
If boolstatus = False Then ErrorMsg SwApp, "Failed to
override value of direction 1 spacing increment at instance (4, 1)": GoTo
LastLine
boolstatus = Part.FeatureManager.InsertVaryInstanceOverride("Space
Increment", 2, 2, 1, 2, 3, 0.15)
If boolstatus = False Then ErrorMsg SwApp, "Failed to
override value of direction 2 spacing increment at instance (2, 3)": GoTo
LastLine
Dim myFeature As SldWorks.Feature
Set myFeature = Part.FeatureManager.FeatureLinearPattern3(5,
0.02, 4, 0.025, False, True, "NULL", "NULL", False, True)
If myFeature Is Nothing Then ErrorMsg SwApp, "Failed to
create a vary instance linear pattern": GoTo LastLine
LastLine:
End Sub
Function ErrorMsg(SwApp As Object, Message As String)
SwApp.SendMsgToUser2 Message, 0, 0
SwApp.RecordLine "'*** WARNING - General"
SwApp.RecordLine "'*** " & Message
SwApp.RecordLine ""
End Function