首先录制一段生成拉伸特征的宏,然后分析这段VBA代码。
录制宏:
1.调用宏录制功能;
2.插入拉伸特征
2.1 绘制草图
2.2 完成特征创建
3. 得到拉伸特征
查看宏代码
1 ' ******************************************************************************
2 ' C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\swx1944\Macro1.swb - macro recorded on 02/20/09 by Administrator
3 ' ******************************************************************************
4 Dim swApp As Object
5 Dim Part As Object
6 Dim SelMgr As Object
7 Dim boolstatus As Boolean
8 Dim longstatus As Long, longwarnings As Long
9 Dim Feature As Object
10 Sub main()
11
12 Set swApp = Application.SldWorks
13 Set Part = swApp.ActiveDoc
14 Set SelMgr = Part.SelectionManager
15
16 boolstatus = Part.Extension.SelectByID2("前视基准面", "PLANE", -0.02702695540936, 0.05597407407407, 0, False, 0, Nothing, 0)
17 '1.草绘开始
18 Part.SketchManager.InsertSketch True
19 Part.ClearSelection2 True
20 '2.1 绘制多边形
21 Dim vSkLines As Variant
22 vSkLines = Part.SketchManager.CreatePolygon(0, 0, 0, 0.06108281893004, -0.02843127572016, 0, 6, True)
23 Part.ClearSelection2 True
24 '2.2 绘制圆
25 Dim SkCircle As Object
26 Set SkCircle = Part.SketchManager.CreateCircle(0, -0.005126179673967, 0, 0.02643220164609, -0.01865802469136, 0)
27 Part.ClearSelection2 True
28 '3.草绘结束
29 Part.SketchManager.InsertSketch True
30
31 Part.ShowNamedView2 "*上下二等角轴测", 8
32 Part.SketchManager.InsertSketch True
33 Part.ClearSelection2 True
34 '4.拉伸特征
35 boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
36 Part.FeatureManager.FeatureExtrusion2 True, False, False, 0, 0, 0.05, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 1, 1, 1, 0, 0, False
37 Part.SelectionManager.EnableContourSelection = 0
38 End Sub
2 ' C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp\swx1944\Macro1.swb - macro recorded on 02/20/09 by Administrator
3 ' ******************************************************************************
4 Dim swApp As Object
5 Dim Part As Object
6 Dim SelMgr As Object
7 Dim boolstatus As Boolean
8 Dim longstatus As Long, longwarnings As Long
9 Dim Feature As Object
10 Sub main()
11
12 Set swApp = Application.SldWorks
13 Set Part = swApp.ActiveDoc
14 Set SelMgr = Part.SelectionManager
15
16 boolstatus = Part.Extension.SelectByID2("前视基准面", "PLANE", -0.02702695540936, 0.05597407407407, 0, False, 0, Nothing, 0)
17 '1.草绘开始
18 Part.SketchManager.InsertSketch True
19 Part.ClearSelection2 True
20 '2.1 绘制多边形
21 Dim vSkLines As Variant
22 vSkLines = Part.SketchManager.CreatePolygon(0, 0, 0, 0.06108281893004, -0.02843127572016, 0, 6, True)
23 Part.ClearSelection2 True
24 '2.2 绘制圆
25 Dim SkCircle As Object
26 Set SkCircle = Part.SketchManager.CreateCircle(0, -0.005126179673967, 0, 0.02643220164609, -0.01865802469136, 0)
27 Part.ClearSelection2 True
28 '3.草绘结束
29 Part.SketchManager.InsertSketch True
30
31 Part.ShowNamedView2 "*上下二等角轴测", 8
32 Part.SketchManager.InsertSketch True
33 Part.ClearSelection2 True
34 '4.拉伸特征
35 boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
36 Part.FeatureManager.FeatureExtrusion2 True, False, False, 0, 0, 0.05, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 1, 1, 1, 0, 0, False
37 Part.SelectionManager.EnableContourSelection = 0
38 End Sub
代码分析:
FeatureManager类的FeatureExtrusion2方法用来生成拉伸特征。当然在生成特征前需要我们使用SelectByID2方法选中要拉伸的轮廓(就是草图)。