Bonjour,
Ne pas sous-estimer l’utilité de l’enregistrement de macro.
Voici une macro que j’ai enregistré et qui répond à cette demande :
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("Plan de dessus", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstToRectEntity, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True)
boolstatus = Part.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swSketchAddConstLineDiagonalType, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True)
Dim vSkLines As Variant
vSkLines = Part.SketchManager.CreateCenterRectangle(0, 0, 0, 0.222, 0.1665, 0)
' Named View
Part.ShowNamedView2 "*Isométrique", 7
Part.ViewZoomtofit2
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateLine(-0#, -0.1665, 0#, 0#, 0.1665, 0#)
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateLine(-0.222, 0#, 0#, 0.222, 0#, 0#)
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Esquisse1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.InsertWeldmentFeature()
boolstatus = Part.Extension.SelectByID2("Line2@Esquisse1", "EXTSKETCHSEGMENT", -0.222, -8.77585521755009E-02, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line3@Esquisse1", "EXTSKETCHSEGMENT", -0.14708588433075, 0.1665, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line4@Esquisse1", "EXTSKETCHSEGMENT", 0.222, 7.22480810802039E-02, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line1@Esquisse1", "EXTSKETCHSEGMENT", 7.30118244492815E-02, -0.1665, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line7@Esquisse1", "EXTSKETCHSEGMENT", 0, -6.42442245170969E-02, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line8@Esquisse1", "EXTSKETCHSEGMENT", -0.148081910198584, 0, 0, True, 0, Nothing, 0)
Dim vGroups As Variant
Dim GroupArray() As Object
ReDim GroupArray(0 To 2) As Object
Dim Group1 As Object
Set Group1 = Part.FeatureManager.CreateStructuralMemberGroup()
Dim vSegement1 As Variant
Dim SegementArray1() As Object
ReDim SegementArray1(0 To 3) As Object
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line2@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line3@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line4@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line1@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
Dim Segment As Object
Set Segment = Part.SelectionManager.GetSelectedObject5(1)
Set SegementArray1(0) = Segment
Set Segment = Part.SelectionManager.GetSelectedObject5(2)
Set SegementArray1(1) = Segment
Set Segment = Part.SelectionManager.GetSelectedObject5(3)
Set SegementArray1(2) = Segment
Set Segment = Part.SelectionManager.GetSelectedObject5(4)
Set SegementArray1(3) = Segment
vSegement1 = SegementArray1
Group1.Segments = (vSegement1)
Group1.ApplyCornerTreatment = True
Group1.CornerTreatmentType = 1
Group1.GapWithinGroup = 0
Group1.GapForOtherGroups = 0
Group1.Angle = 0
Set GroupArray(0) = Group1
Dim Group2 As Object
Set Group2 = Part.FeatureManager.CreateStructuralMemberGroup()
Dim vSegement2 As Variant
Dim SegementArray2() As Object
ReDim SegementArray2(0 To 0) As Object
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line7@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
Set Segment = Part.SelectionManager.GetSelectedObject5(1)
Set SegementArray2(0) = Segment
vSegement2 = SegementArray2
Group2.Segments = (vSegement2)
Group2.ApplyCornerTreatment = True
Group2.CornerTreatmentType = 1
Group2.GapWithinGroup = 0
Group2.GapForOtherGroups = 0
Group2.Angle = 0
Set GroupArray(1) = Group2
Dim Group3 As Object
Set Group3 = Part.FeatureManager.CreateStructuralMemberGroup()
Dim vSegement3 As Variant
Dim SegementArray3() As Object
ReDim SegementArray3(0 To 0) As Object
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line8@Esquisse1", "EXTSKETCHSEGMENT", -0.716861233578527, 0, 7.41652842845042E-02, True, 0, Nothing, 0)
Set Segment = Part.SelectionManager.GetSelectedObject5(1)
Set SegementArray3(0) = Segment
vSegement3 = SegementArray3
Group3.Segments = (vSegement3)
Group3.ApplyCornerTreatment = True
Group3.CornerTreatmentType = 1
Group3.GapWithinGroup = 0
Group3.GapForOtherGroups = 0
Group3.Angle = 0
Set GroupArray(2) = Group3
vGroups = GroupArray
Set myFeature = Part.FeatureManager.InsertStructuralWeldment4("C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\french\weldment profiles\iso\pipe.sldlfp", 1, True, (vGroups))
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Pipe - configured 21.3 X 2.3(1)", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
End Sub
Mecanauto_3.swp (42,5 Ko)
Macro qui génère ceci :