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

如圖所示,鉆孔直徑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

复制代码

ISketchManager::AddToDBalso avoids some of the peculiarities involved with creating entities via theuser interface, such as inferencing, automatic relations, and snapping to thegrid. Adding entities directly to the database also significantly increases theperformance of this method. When you are done creating entities, it isimportant to ISketchManager::AddToDB(False), to restore SolidWorks to itsnormal operating mode.

ISketchManager：AddToDB还避免了通过用户界面创建实体所涉及的一些特性，例如推理、自动关系和与网格的切换。将实体直接添加到数据库中也显著提高了该方法的性能。创建实体后，对于ISketchManager：AddToDB(False)来说，将SolidWorks恢复到其正常运行模式非常重要。

One of the benefitsof adding sketch entities directly to the database is that you can avoid gridand entity snapping. For example, if you create a sketch line whose endpoint isnear another entity or near a grid point, the new line endpoint snaps to theother item or grid point. Setting ISketchManager::AddToDB to true avoids thisbehavior during sketch entity creation.

将草图实体直接添加到数据库的好处之一是可以避免网格和实体抓取。例如，如果您创建了一个草图线，其端点位于另一个实体附近或网格点附近，则新的线端点将切换到另一个项或网格点。将ISketchManager：AddToDB设置为true，可以避免在创建草图实体时发生这种行为。

1. Sub Draw_()
   
2. With UserForm1
   
3. '
   
4. If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
   
5.       MsgBox ("Enter empty")
   
6.       Exit Sub
   
7. End If
   
8. '
   
9. Drill_Diameter = .TextBox3.Value / 1000
   
10. Start_Circle_radius = .TextBox4.Value / 1000
    
11. If Drill_Diameter >= Start_Circle_radius Then
    
12.       MsgBox ("Data error")
    
13.       Exit Sub
    
14. End If
    
15. Set swApp = Application.SldWorks
    
16. Set Part = swApp.ActiveDoc
    
17. Set swModel = swApp.ActiveDoc
    
18. Set swSketchMgr = swModel.SketchManager
    
19. Part.SketchManager.InsertSketch True '
    
20. 
    
21. swModel.SketchManager.AddToDB = True
    
22. X1 = .TextBox1.Value / 1000
    
23. Y1 = .TextBox2.Value / 1000
    
24. X2 = X1 + Drill_Diameter / 2
    
25. Set swSketchSegment = swSketchMgr.CreateCircle(X1, Y1, 0#, X2, Y1, 0#)
    
26. 
    
27. pi = Atn(1) * 4
    
28. Circle_number = .TextBox6.Value
    
29. Drill_depth = .TextBox5.Value / 1000
    
30. For i = 1 To Circle_number
    
31.       Circle_radius = i * Start_Circle_radius
    
32.       Copy_Number = Int(2 * Circle_radius * pi / Start_Circle_radius + 0.5)
    
33. 
    
34.       BX1 = X1 + Circle_radius
    
35.       BX2 = BX1 + Drill_Diameter / 2
    
36.       Set swSketchSegment = swSketchMgr.CreateCircle(BX1, Y1, 0#, BX2, Y1, 0#)
    
37. 
    
38.       boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Circle_radius, pi, Copy_Number, 2 * pi, True, "", True, True, True)
    
39. Next
    
40. End With
    
41. swModel.SketchManager.AddToDB = False
    
42. 
    
43. Dim myFeature As Object
    
44. Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
    
45. 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
    
46. End Sub

复制代码

pyczt 发表于 2018-5-25 08:18
ISketchManager::AddToDBalso avoids some of the peculiarities involved with creating entities via the ...

如上原程式補加 swModel.SketchManager.AddToDB = True  後,

不但解決了 x=0,y=0 的問題,也一併解決了 X 為負值的問題,再次謝謝 pyczt 大大的幫忙.

很神奇的宏！

提点建议：1. 中心的孔做个选择，可以钻也可不钻；2. 首圈孔的个数可以自定义，现在是固定的6个。这样更人性化

qxzch 发表于 2018-5-27 18:11
提点建议：1. 中心的孔做个选择，可以钻也可不钻；2. 首圈孔的个数可以自定义，现在是固定的6个。这样更人 ...

首圈半徑近似於相鄰兩孔之中心(弧長)距離.


為了滿足如上條件才6个.

点了就要下载啊，本来就却积分

怎么提是empty