宏-草圖圓周複製後拉伸
分享在他網的回題小程式,適合想學sw API的初學者參考!' ******************************************************************************
' macro recorded on 05/12/18 by scliang
' 功能:草圖圓周複製後拉伸
' 操作: 開新零件,執行 main
'
' ******************************************************************************
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchSegment As SldWorks.SketchSegment
Dim boolstatus As Boolean
Dim Part As Object
Dim myFeature As Object
Dim pi, ArcRadius, ArcAngle, PatternSpacing As Double
Dim n As Integer
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' Create part document
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
pi = Atn(1) * 4 '圓周率
ArcRadius = 0.05 '圓弧半徑
ArcAngle = 300 * pi / 180 '圓周中心之圓弧角
n = 5 '複製數
PatternSpacing = 40 * pi / 180 '複製之間隔弧度
' Sketch a circle
'boolstatus = Part.Extension.SelectByID2("前基準面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
swModel.ShowNamedView2 "*Front", 1
Set swSketchSegment = swSketchMgr.CreateCircle(0.01, 0.06, 0#, 0.01, 0.07, 0#) '畫圓
'value = instance.CreateCircularSketchStepAndRepeat(ArcRadius, ArcAngle, PatternNum, PatternSpacing, PatternRotate, _
DeleteInstances)圓弧半徑、圓弧角、複製數、複製間距(+ 間隔弧度正轉,- 間隔弧度逆轉)、圖案旋轉、刪除實例
boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(ArcRadius, ArcAngle, n, PatternSpacing, False, True, True, True, True) '圓周複製
'instance.FeatureExtrusion2(Sd, Flip, Dir(反轉方向), T1, T2, D1, D2, Dchk1, Dchk2, Ddir1, Ddir2, Dang1, Dang2, OffsetReverse1, OffsetReverse2, Merge)
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.03, 0, False, False, False, False, _
0, 0, False, False, False, False, True, True, True, 0, 0, False) '拉伸 30mm
End Sub
页:
[1]