方圓孔圓周分佈-宏（方圆孔圆周分布宏）有找不到工程或库及属性的使用无效解释

ryouss

https://www.swbbsc.com/forum.php? ... 1208&extra=page%3D1

1. 這是如上的升級版,在 pyczt大大 的指導下改進了不管XY為正負值或是0皆可執行,
    並新增加打方孔.
2. 個人覺得宏的執行功能在应用上是較為其次,反而是給新入門有心學習宏的是不錯的範例.
3. 可能尚有其他未發現問題有興趣者試試了.

注意事項:
1.首圈半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.5倍(避免破孔或是零厚度).
2.草圖上不要用網格,避免取點時被吸附至網點.


附SWP文件 Circle distribution_0530.rar (48.83 KB, 下载次数: 223, 售价: 30 金币)

2018-5-30 23:35 上传

点击文件名下载附件
售价: 30 金币  [记录]
下载积分: 金币 -1

1. ' *************************************************************
   
2. ' macro recorded on 05/28/18 by scliang
   
3. '     功能:圓周分佈方圓孔,本範例因是用除料拉伸,所以鉆孔是平底.
   
4. '     操作:1.在零件先選取要打孔之平面.
   
5. '          2.執行 "main" .
   
6. '          3.選取打孔類別,TextBox(文本框)鍵入相關參數值.
   
7. '          4.首圈半徑近似於相鄰兩孔之中心(弧長)距離.
   
8. '          5.方孔邊長=圓孔直徑.
   
9. ' 注意事項:起始圓半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.5倍
   
10. '
    
11. ' *************************************************************
    
12. 
    
13. Dim A1X As Double 'TextBox1
    
14. Dim A1Y As Double 'TextBox2
    
15. Dim A2X As Double
    
16. Dim A3X As Double
    
17. Dim A3Y As Double
    
18. Dim B1X As Double
    
19. Dim B1Y As Double
    
20. Dim B2X As Double
    
21. Dim B2Y As Double
    
22. Dim B3X As Double
    
23. Dim B3Y As Double
    
24. Dim D As Double 'TextBox3
    
25. Dim R1 As Double 'TextBox4
    
26. Dim Drill_depth As Double 'TextBox5
    
27. Dim Circle_number As Integer 'TextBox6
    
28. Dim i As Integer
    
29. Dim Class_ As Integer
    
30. Dim pi As Double
    
31. Dim RN As Double
    
32. Dim ArcRadius As Double
    
33. Dim ArcAngle As Double
    
34. 
    
35. Sub main()
    
36. UserForm1.Show 0
    
37. End Sub
    
38. 
    
39. Sub Draw()
    
40. With UserForm1
    
41. .Label8.Caption = ""
    
42. Class_ = .ComboBox1.ListIndex  '孔類代碼 0-->圓孔,1-->方孔
    
43. '判定資料是否沒打入
    
44. If .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
    
45.       MsgBox ("Enter empty")
    
46.       Exit Sub
    
47. End If
    
48. '判定資料是否是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.5倍)
    
49. D = .TextBox3.Value / 1000 '孔直徑=方孔邊長
    
50. R1 = .TextBox4.Value / 1000 '首圈中心半徑
    
51. If (Class_ = 0 And D >= R1) Or (Class_ = 1 And R1 / D < 1.4999) Then
    
52.       MsgBox ("Data error")
    
53.       Exit Sub
    
54. End If
    
55. 
    
56. Set swApp = Application.SldWorks
    
57. Set Part = swApp.ActiveDoc
    
58. Set swSketchMgr = Part.SketchManager
    
59. Part.SketchManager.InsertSketch True '依據選取面插入草圖
    
60. Part.SketchManager.AddToDB True  '草圖實體直接添加到數據庫(否則 x<=0 會有問題)
    
61. '中心圓之座標及作圖
    
62. A1X = .TextBox1.Value / 1000 '圓周複製中心 X 座標
    
63. A1Y = .TextBox2.Value / 1000 '圓周複製中心 Y 座標
    
64. A2X = A1X + D / 2 '中心圓之半徑 X 座標
    
65. pi = Atn(1) * 4
    
66. Circle_number = .TextBox6.Value '複製圈數
    
67. Drill_depth = .TextBox5.Value / 1000 '鉆孔深
    
68. '判定孔類之圓周分佈打孔
    
69. Select Case Class_
    
70. Case 0  '打圓孔
    
71. Set swSketchSegment = swSketchMgr.CreateCircle(A1X, A1Y, 0#, A2X, A1Y, 0#) '作中心圓
    
72. For i = 1 To Circle_number
    
73.       RN = i * R1 '分佈圓周之半徑
    
74.       copy_number = Int(2 * RN * pi / R1 + 0.5) '分佈圓周之鉆孔數
    
75.       Totle_drill_hole = Totle_drill_hole + copy_number '累加各圈孔數
    
76. '分佈圓之基圓作圖
    
77.       B1X = A1X + RN
    
78.       B2X = B1X + D / 2
    
79.       Set swSketchSegment = swSketchMgr.CreateCircle(B1X, A1Y, 0#, B2X, A1Y, 0#) '各圈基孔
    
80. '分佈圓之複製孔數,圓周複製參數:圓弧半徑、圓弧角、複製數、孔間距(間隔弧度)、圖案旋轉、刪除實例
    
81.       boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(RN, pi, copy_number, 2 * pi, True, "", True, True, True)
    
82. Next
    
83. 
    
84. Case 1 '打方孔
    
85. A3X = A1X - D / 2
    
86. A3Y = A1Y + D / 2
    
87. vSkLines = swSketchMgr.CreateCenterRectangle(A1X, A1Y, 0#, A3X, A3Y, 0#) '中心方孔
    
88. '~~~ 約束共點之初值 ~~~
    
89. Dim NamePoint As String
    
90. Dim NumPoint As Integer
    
91. If A1X = 0 And A1Y = 0 Then
    
92. NumPoint = 6
    
93. Else
    
94. NumPoint = 5
    
95. End If
    
96. '~~~~~~~~~~~~~~~~~
    
97. For i = 1 To Circle_number
    
98. '中心圓之座標及作圖
    
99.       RN = i * R1 '分佈圓周之半徑
    
100.       B1X = A1X + RN
     
101.       B1Y = A1Y
     
102.       B3X = B1X - D / 2
     
103.       B3Y = A3Y
     
104. 
     
105.       vSkLines = swSketchMgr.CreateCenterRectangle(B1X, B1Y, 0, B3X, B3Y, 0) '各圈基準方孔
     
106.       ArcAngle = pi - Atn(D / 2 / (RN - D / 2)) '圓周複製弧角
     
107.       ArcRadius = Sqr((D / 2) ^ 2 + (RN - D / 2) ^ 2) '圓周複製半徑
     
108.       copy_number = Int(2 * RN * pi / R1 + 0.5) '複製數
     
109.       Debug.Print copy_number
     
110.       NumPoint = NumPoint + 5 * copy_number + 1      '點計數
     
111.       Totle_drill_hole = Totle_drill_hole + copy_number
     
112.       boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(ArcRadius, ArcAngle, copy_number, 2 * pi, False, "", False, False, False)
     
113. NamePoint = "Point" & NumPoint
     
114. 'Debug.Print NamePoint
     
115. Part.Extension.SelectByID2 NamePoint, "SKETCHPOINT", 0, 0, 0, False, 0, Nothing, 0 '圓周複製中心點
     
116. Part.Extension.SelectByID2 "Point1", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0 '輸入的XY座標點
     
117. Part.SketchAddConstraints "sgCOINCIDENT" '取圓周複製中心點和輸入的XY座標點 "共點約束"
     
118. Part.ClearSelection2 True
     
119. Next
     
120. End Select
     
121. 
     
122. .Label8.Caption = 1 + Totle_drill_hole '總鉆孔數
     
123. End With
     
124. Part.SketchManager.AddToDB False
     
125. '除料拉伸
     
126. Dim myFeature As Object
     
127. Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
     
128. 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
     
129. End Sub

复制代码

hhww81

很不错，感谢楼主

asd4015053

版大：

一开始运行时，是这样：






然后我加了如下三句：

Dim Part As SldWorks.ModelDoc2
Dim swModel  As SldWorks.ModelDoc2       '定义SW文档
Dim swSketchMgr  As SldWorks.SelectionMgr    '定义SW选择管理器


然后，再运行，还是不行：





求解决，谢谢！

ryouss

asd4015053 发表于 2018-6-1 11:29
版大：

一开始运行时，是这样：

謝謝測試,請告知使用版本.

asd4015053

   经典案例图书

ryouss 发表于 2018-6-1 11:34
謝謝測試,請告知使用版本.

感谢版大回复，我是2018版的，SP0

asd4015053

又试了一下，没有问题，是我引用的库丢失了
之前有两个丢失的2012引用

asd4015053

   经典案例图书

不过只能创建一个孔，没有阵列，奇怪

asd4015053

圆孔没有问题

ryouss

asd4015053 发表于 2018-6-1 12:39
圆孔没有问题

草圖上不要用網格,避免取點時被吸附至網點.

注意如上之提示,在 2012,2015,2017試過正常,就是手上沒2018可試.
再有問題在執行宏前,進入 工具-->選項, 禁用限制約束及磁性結合.

ryouss

另VBA宏繁簡字的更改一键复制解繁简乱码！
試用看看 解繁简乱码.rar (778.48 KB, 下载次数: 196, 售价: 45 金币)

2018-6-1 17:44 上传

点击文件名下载附件
售价: 45 金币  [记录]
下载积分: 金币 -1

复制全部宏==>试试“Uni简”或是“B>G”按钮即可

asd4015053

感谢版大，不过不知道为什么出来是这样

asd4015053

另外，中心点，不知道为什么，无法位于草图中点

ryouss

asd4015053 发表于 2018-6-1 14:59
另外，中心点，不知道为什么，无法位于草图中点

謝謝大大用心測試

參看9#

asd4015053

ryouss 发表于 2018-6-1 15:01
謝謝大大用心測試

參看9#

感谢，刚才有一项忘记设置了，唯一的问题中心点，不能居中

ryouss

加入QQ群
参与讨论和学习

或扫描二维码加入

asd4015053 发表于 2018-6-1 15:08
感谢，刚才有一项忘记设置了，唯一的问题中心点，不能居中

圖形正確的,因設定為 X,Y=50,當然偏離原點了.

要對正原點應鍵入  X=0,Y=0

asd4015053

   经典案例图书

是，是我也是刚理解X、Y的意义，不过设置了0、0，后，是这样，第一个是对齐了，不知道为什么后续的不行

asd4015053

加入QQ群
参与讨论和学习

或扫描二维码加入

设为10、10，就是偏一点，就正常，设置为0、0，就不行




奇怪

asd4015053

   经典案例图书

ryouss

asd4015053 发表于 2018-6-1 15:34
设为10、10，就是偏一点，就正常，设置为0、0，就不行

試了,X,Y=0 時,  工具-->選項之 限制約束又要打勾了.
理解是XY座標點(0,0)必須要找原點共點約束吧!

SHXIANG

感谢楼主分享，很不错！