圓周分布鉆孔-宏 (已解決)

ryouss

如圖所示,鉆孔直徑8時原點有孔,但改為鉆孔直徑5時原點就沒有孔,
有興趣者幫看一下,可否有解決方法!
宏是在2012版編程的.

附SWP文件  


原點沒孔

原點有孔

1. ' *************************************************************
   
2. ' macro recorded on 05/20/18 by scliang
   
3. ' 功能:圓周分佈鉆孔,本範例因是用除料拉伸,所以鉆孔是平底.
   
4. ' 操作: 1.在零件先選取要鉆孔之平面.
   
5. '       2.執行 "main" .
   
6. '       3.X座標取正數,若是負數可能會出錯.
   
7. '       4.首圈半徑近似於相鄰兩孔之中心(弧長)距離.
   
8. '
   
9. ' *************************************************************
   
10. 
    
11. Dim X1 As Double 'TextBox1
    
12. Dim Y1 As Double 'TextBox2
    
13. Dim Drill_Diameter As Double 'TextBox3
    
14. Dim Start_Circle_radius As Double 'TextBox4
    
15. Dim Drill_depth As Double 'TextBox5
    
16. Dim Circle_number  As Integer 'TextBox6
    
17. Dim X2 As Double
    
18. Dim BX1 As Double
    
19. Dim BX2 As Double
    
20. Dim pi As Double
    
21. Dim Circle_radius As Double
    
22. 
    
23. Sub main()
    
24. UserForm1.Show
    
25. End Sub
    
26. 
    
27. Sub Draw_()
    
28. With UserForm1
    
29. '判定資料是否沒打入
    
30. If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
    
31.       MsgBox ("Enter empty")
    
32.       Exit Sub
    
33. End If
    
34. '判定資料是否是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑)
    
35. Drill_Diameter = .TextBox3.Value / 1000
    
36. Start_Circle_radius = .TextBox4.Value / 1000
    
37. If Drill_Diameter >= Start_Circle_radius Then
    
38.       MsgBox ("Data error")
    
39.       Exit Sub
    
40. End If
    
41. Set swApp = Application.SldWorks
    
42. Set Part = swApp.ActiveDoc
    
43. Set swModel = swApp.ActiveDoc
    
44. Set swSketchMgr = swModel.SketchManager
    
45. Part.SketchManager.InsertSketch True '依據選取面插入草圖
    
46. '中心圓之座標及作圖
    
47. X1 = .TextBox1.Value / 1000
    
48. Y1 = .TextBox2.Value / 1000
    
49. X2 = X1 + Drill_Diameter / 2
    
50. Set swSketchSegment = swSketchMgr.CreateCircle(X1, Y1, 0#, X2, Y1, 0#)
    
51. '圓周分佈之鉆孔
    
52. pi = Atn(1) * 4
    
53. Circle_number = .TextBox6.Value
    
54. Drill_depth = .TextBox5.Value / 1000 '鉆孔深
    
55. For i = 1 To Circle_number
    
56.       Circle_radius = i * Start_Circle_radius '分佈圓周之半徑
    
57.       Copy_Number = Int(2 * Circle_radius * pi / Start_Circle_radius + 0.5) '分佈圓周之鉆孔數
    
58. '分佈圓之基圓作圖
    
59.       BX1 = X1 + Circle_radius
    
60.       BX2 = BX1 + Drill_Diameter / 2
    
61.       Set swSketchSegment = swSketchMgr.CreateCircle(BX1, Y1, 0#, BX2, Y1, 0#)
    
62. '分佈圓之複製孔數,圓周複製參數:圓弧半徑、圓弧角、花紋數、花紋間距(間隔弧度)、圖案旋轉、刪除實例
    
63.       boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Circle_radius, pi, Copy_Number, 2 * pi, True, "", True, True, True)
    
64. Next
    
65. End With
    
66. '除料拉伸
    
67. Dim myFeature As Object
    
68. Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
    
69. 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
    
70. End Sub

复制代码

pyczt

ryouss

qxzch

qxzch

ryouss

Trouble12138

makejon