圓周分布鉆孔-宏 (已解決) - iCAx开思网

' *************************************************************
' macro recorded on 05/20/18 by scliang
' 功能:圓周分佈鉆孔,本範例因是用除料拉伸,所以鉆孔是平底.
' 操作: 1.在零件先選取要鉆孔之平面.
' 2.執行 "main" .
' 3.X座標取正數,若是負數可能會出錯.
' 4.首圈半徑近似於相鄰兩孔之中心(弧長)距離.
'
' *************************************************************
Dim X1 As Double 'TextBox1
Dim Y1 As Double 'TextBox2
Dim Drill_Diameter As Double 'TextBox3
Dim Start_Circle_radius As Double 'TextBox4
Dim Drill_depth As Double 'TextBox5
Dim Circle_number As Integer 'TextBox6
Dim X2 As Double
Dim BX1 As Double
Dim BX2 As Double
Dim pi As Double
Dim Circle_radius As Double
Sub main()
UserForm1.Show
End Sub
Sub Draw_()
With UserForm1
'判定資料是否沒打入
If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
MsgBox ("Enter empty")
Exit Sub
End If
'判定資料是否是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑)
Drill_Diameter = .TextBox3.Value / 1000
Start_Circle_radius = .TextBox4.Value / 1000
If Drill_Diameter >= Start_Circle_radius Then
MsgBox ("Data error")
Exit Sub
End If
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
Part.SketchManager.InsertSketch True '依據選取面插入草圖
'中心圓之座標及作圖
X1 = .TextBox1.Value / 1000
Y1 = .TextBox2.Value / 1000
X2 = X1 + Drill_Diameter / 2
Set swSketchSegment = swSketchMgr.CreateCircle(X1, Y1, 0#, X2, Y1, 0#)
'圓周分佈之鉆孔
pi = Atn(1) * 4
Circle_number = .TextBox6.Value
Drill_depth = .TextBox5.Value / 1000 '鉆孔深
For i = 1 To Circle_number
Circle_radius = i * Start_Circle_radius '分佈圓周之半徑
Copy_Number = Int(2 * Circle_radius * pi / Start_Circle_radius + 0.5) '分佈圓周之鉆孔數
'分佈圓之基圓作圖
BX1 = X1 + Circle_radius
BX2 = BX1 + Drill_Diameter / 2
Set swSketchSegment = swSketchMgr.CreateCircle(BX1, Y1, 0#, BX2, Y1, 0#)
'分佈圓之複製孔數,圓周複製參數:圓弧半徑、圓弧角、花紋數、花紋間距(間隔弧度)、圖案旋轉、刪除實例
boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Circle_radius, pi, Copy_Number, 2 * pi, True, "", True, True, True)
Next
End With
'除料拉伸
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
End Sub

复制代码

Sub Draw_()
With UserForm1
'
If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
MsgBox ("Enter empty")
Exit Sub
End If
'
Drill_Diameter = .TextBox3.Value / 1000
Start_Circle_radius = .TextBox4.Value / 1000
If Drill_Diameter >= Start_Circle_radius Then
MsgBox ("Data error")
Exit Sub
End If
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager
Part.SketchManager.InsertSketch True '
swModel.SketchManager.AddToDB = True
X1 = .TextBox1.Value / 1000
Y1 = .TextBox2.Value / 1000
X2 = X1 + Drill_Diameter / 2
Set swSketchSegment = swSketchMgr.CreateCircle(X1, Y1, 0#, X2, Y1, 0#)
pi = Atn(1) * 4
Circle_number = .TextBox6.Value
Drill_depth = .TextBox5.Value / 1000
For i = 1 To Circle_number
Circle_radius = i * Start_Circle_radius
Copy_Number = Int(2 * Circle_radius * pi / Start_Circle_radius + 0.5)
BX1 = X1 + Circle_radius
BX2 = BX1 + Drill_Diameter / 2
Set swSketchSegment = swSketchMgr.CreateCircle(BX1, Y1, 0#, BX2, Y1, 0#)
boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Circle_radius, pi, Copy_Number, 2 * pi, True, "", True, True, True)
Next
End With
swModel.SketchManager.AddToDB = False
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
End Sub

复制代码