變徑孔圓周複製-宏

ryouss

  h9 l9 @7 D, d; D! Z$ o
參考    swp文件
4 W% x& q! i# `  q3 G3 L8 S


: l" R6 B% S. K* F
  }7 r/ ]2 o* @6 S

; k2 `4 N9 p% P

1. '   孔徑變化之圓周複製 2018/12/17 SW2012-SP4 測試
   7 Z, N7 I6 r) a$ b+ l
2. '
   " P) i! {. g- ~2 S. \
3. <font color="#0000ff"><b>'   ~~~ 提示 ~~~
   $ j, T! H+ m/ ]! `4 l2 D
4. '   1. 在零件選取作孔之平面
   1 e# {+ C' G7 d/ |6 b( {2 }6 h
5. '   2. 執行 main宏.
   
6. '   3. 在 UserForm 鍵入數據.
   , y1 ^8 \2 }! v9 n
7. '   4. 在 UserForm 按 "執行鍵".
   . H0 ?9 b8 {6 V. E1 t5 L
8. '   5. 中心基孔定義在原點.</b></font>
     g& I3 t! A: k, C# c7 h. ]1 c
9. 
   
10. Dim swApp As Object
    5 v* j( t7 S0 u, P  h7 P, |# U
11. Dim pi As Double
    
12. Dim R0 As Double
    
13. Dim HoleDiameterDiffer As Double
    $ B7 M; h7 `- J( o8 Y
14. Dim CircllHoleEdge As Double
    6 f# V3 E0 V. t
15. Dim CirclInsideHoleEdge As Double
    ' s5 x" I/ u" M) ^, Q
16. Dim i, CircleNumber, CopyNunber, TotalCopyNunber As Integer
    
17. Dim Dn As Double
    
18. Dim Rn As Double
    8 Z8 a& X; {" i3 C1 f# ]
19. Dim XRn As Double
    ) `' h: _# A# V$ d$ W& k7 E
20. 
    , S4 E% X3 ~0 b( F
21. '~~~ 主程式 ~~~
    
22. Sub main()
    # [7 D# w7 u9 I! W* W/ r
23. UserForm1.Show 1
    
24. End Sub
    4 Z4 j( ^- q, [
25. 
    
26. '~~~ 作圖 ~~~
    1 m/ R  a: J2 _% c
27. Sub Draw()
    ' S( s. e. V! O6 Q
28. With UserForm1
    
29. '判定資料是否沒打入
    ; W# e: ?/ O; e+ k; k
30. If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Then
    0 B8 n  b6 U  b( e$ y
31.       MsgBox ("Enter empty")
    $ s+ T/ s" m7 t* A/ Q4 G& F' U$ s
32.       Exit Sub
    
33. End If
    % n! W9 m/ J$ U) W0 j9 S4 a
34. Set swApp = Application.SldWorks
    
35. Set Part = swApp.ActiveDoc
    . q2 Z/ S2 T( a7 A* e* u
36. Set swSketchMgr = Part.SketchManager
    
37. Part.SketchManager.InsertSketch True '依據選取面插入草圖
    
38. Part.SketchManager.AddToDB True  '草圖實體直接添加到數據庫(否則 x<=0 會有問題)
    & o4 p4 ^# E" {9 m4 V2 S
39. pi = Atn(1) * 4 '圓周率
    
40. HoleDiameterDiffer = .TextBox2.Value / 1000 '各周孔直徑之差值
    
41. CircleNumber = .TextBox3.Value '周圈數
    . n# @3 [+ o6 i* U. H3 f
42. CircllHoleEdge = .TextBox4.Value / 1000 '周和周之孔邊間距
    
43. CirclInsideHoleEdge = .TextBox5.Value / 1000 '周圈內之孔邊間距
    
44. '原點中心圓作圖
    2 M8 ]7 j9 \% D  m9 |, h' X+ L1 F) L+ Z
45. R0 = .TextBox1.Value / 2000 '中心圓半徑
    7 Y4 ~$ g) }, j" Y2 o3 f
46. Set swSketchSegment = swSketchMgr.CreateCircle(0, 0, 0#, R0, 0, 0#) '作中心圓
    9 K( \2 ?% Y& @" R0 X* b' q
47. .Label6.Caption = ""
    ; P$ ~4 R/ M" R
48. TotalCopyNunber = 0
    
49. For i = 1 To CircleNumber
    
50.     If .OptionButton1.Value = True Then '遞增
    0 o* ]. k5 @2 B- z& ]: y$ r$ e
51.         Dn = 2 * R0 + i * HoleDiameterDiffer '周圈之孔直徑
    
52.         Rn = i * (2 * R0 + i * HoleDiameterDiffer / 2 + CircllHoleEdge) 'i 周圈之半徑
    5 I. J& T1 y' z: [9 L1 V
53.     Else
    
54.         If .OptionButton2.Value = True Then '遞減
    ' i( l, v5 |/ u& T  S
55.             Dn = 2 * R0 - i * HoleDiameterDiffer '周圈之孔直徑
    
56.             Rn = i * (2 * R0 - i * HoleDiameterDiffer / 2 + CircllHoleEdge) 'i 周圈之半徑
    ) c( I$ @) h' q0 C( ^
57.         Else
    6 }2 W3 D; ~' n% e
58.             Dn = 2 * R0  '周圈之孔直徑皆等
    
59.             Rn = i * (2 * R0 + CircllHoleEdge)  'i 周圈之半徑
    
60.         End If
    $ Y% V# n: }$ ]% W5 s# L/ d7 ?( Y& B* }
61.     End If
    
62.     CopyNunber = Int(2 * Rn * pi / (Dn + CirclInsideHoleEdge) + 0.5) '圓周分布之複製孔數
    
63.     TotalCopyNunber = TotalCopyNunber + CopyNunber
    
64.     XRn = Rn + Dn / 2
    
65. 'Debug.Print Dn & "~~~" & Rn & "~~~" & CopyNunber
    : w' N3 `% \4 H; }3 C7 R
66.     Set swSketchSegment = swSketchMgr.CreateCircle(Rn, 0, 0#, XRn, 0, 0#) '分布圓之基圓作圖
    8 Y) C6 R" f. b
67.     boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Rn, pi, CopyNunber, 2 * pi, True, "", True, True, True) '圓周複製
    
68. Next i
    
69. .Label6.Caption = TotalCopyNunber + 1
    0 ^7 _2 @" k3 D) @* s( D0 V
70. End With
    
71. Part.SketchManager.AddToDB False
    
72. End Sub

复制代码

( B& s4 g9 p; f% v. k

9 d5 v* ~  j0 h: c8 a2 T





2 T  T& O- M% a
' D/ x* {' T4 h0 b; t( I* k* Q

duanyz

感谢楼主分享！

伊玛目

楼主为什么都是繁体字
; y  t0 I0 p5 }

远祥

这个比较好用了，值得推广。

jiangsuwanhua

值得推广

2 k" N. H3 G. C/ W+ L/ n) G1 F1 w# D/ u


/ T4 s4 Z7 V1 w! a万华金属 303不锈钢制造

前景钱

繁体字在台湾用的比较多

qq247529905

56145

一休小和尚S

代码看不懂，文件有吗？

一休小和尚S

一休小和尚S 发表于 2018-12-21 08:26
代码看不懂，文件有吗？

) }! A5 Z* z: R6 o如何使用？

ryouss

* ^8 o/ R; t, A  W1 `4 n

一休小和尚S 发表于 2018-12-21 14:42
, Y2 w6 m+ T) R6 y9 }! N如何使用？

詳看 1#

% s# c! `9 x! X& s5 ~

• '   1. 在零件選取作孔之平面
• '   2. 執行 main宏.
• '   3. 在 UserForm 鍵入數據.
• '   4. 在 UserForm 按 "執行鍵".
• '   5. 中心基孔定義在原點.