圓周分佈鉆孔-宏

ryouss

& m1 ^0 |3 t  |. ~+ [; ?% k/ Y參考


* Q3 O$ h5 x2 a7 |+ K  g4 ^
" Y6 Z* ^" S& Q# w1 a4 L  t


6 C' [) G- x* M" ~

1. Sub Draw_()
   
2. With UserForm1
   
3. '判定資料沒打或是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑)
   & t3 t. w1 ~2 l4 E: S
4. If .TextBox4.Value <= .TextBox3.Value Or .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" _
   
5.       Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
   5 N- L* |6 \8 X7 F3 Y3 O+ x1 u" l, Q- W* c
6.       MsgBox ("Data error Or Data empty")
   
7.       Exit Sub
   
8. End If
   2 L) l  b/ A3 w) z
9. Set swApp = Application.SldWorks
   4 C% s6 F; z& n; ]
10. Set Part = swApp.ActiveDoc
    
11. Set swModel = swApp.ActiveDoc
    : t3 a- P$ n- e# C9 g- @8 l$ R
12. Set swSketchMgr = swModel.SketchManager
    
13. 
    
14. Part.SketchManager.InsertSketch True '依據選取面插入草圖
    ' O" n5 U) w3 _+ }  ~- I6 l
15. '中心圓之座標及作圖
    
16. X1 = .TextBox1.Value / 1000
    ( c5 Q! m6 L$ I, Y
17. Y1 = .TextBox2.Value / 1000
    
18. X2 = X1 + .TextBox3.Value / 2 / 1000
    5 o/ E' [: N* L9 K! \# c& W
19. Set swSketchSegment = swSketchMgr.CreateCircle(X1, Y1, 0#, X2, Y1, 0#)
    
20. '圓周分佈之鉆孔
    
21. pi = Atn(1) * 4
    
22. Drill_Diameter = .TextBox3.Value / 1000
    $ C# a1 x6 N+ s: K' q0 Y1 [
23. Start_Circle_radius = .TextBox4.Value / 1000
    1 c( e2 z4 z6 w- [6 @3 C# E' W
24. Circle_number = .TextBox6.Value
    
25. ArcAngle = pi   '複製孔之圓弧角皆為180度
    
26. Drill_depth = .TextBox5.Value / 1000 '鉆孔深
    - @$ A  o" Q5 a- h" |9 M
27. For i = 1 To Circle_number
    $ e8 |- F; ^6 c5 W
28.       Circle_radius = i * .TextBox4.Value / 1000 '分佈圓周之半徑
    
29.       Copy_Number = Int(2 * Circle_radius * pi / Start_Circle_radius + 0.5) '分佈圓周之鉆孔數
    
30. '分佈圓之基圓作圖
    
31.       BX1 = X1 + Circle_radius
    
32.       BX2 = BX1 + Drill_Diameter / 2
    
33.       Set swSketchSegment = swSketchMgr.CreateCircle(BX1, Y1, 0#, BX2, Y1, 0#)
    
34. '分佈圓之複製孔數,圓周複製參數:圓弧半徑、圓弧角、花紋數、花紋間距(間隔弧度)、圖案旋轉、刪除實例
    ) O9 W- {% Z! ]; W! _, D
35.       boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Circle_radius, ArcAngle, Copy_Number, 2 * pi, True, "", True, True, True)
    
36. Next
    
37. End With
    ( Y8 O- M( y* Q( i
38. Dim myFeature As Object
    
39. Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
    4 l) V9 d5 ?- o" _5 J) ^
40. 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
    
41. End Sub
    
42. 
    * H% f) m' U- N' e
43. Sub main()
    . A# k; h: U( y7 W/ m# ?: D# m1 \
44. UserForm1.Show
    ; h$ ^2 a. K5 N" r. Z1 A
45. End Sub

复制代码

* ^9 C6 ~+ q+ D0 M8 F! R

qiminger

谢谢梁老师分享好方法~学习啦~

魅-影

谢谢梁大分享！

抒怀新

梁大是个编程高手，可惜我们是门外汉，不知如何下手

hidingman

. k& ^& V" G  _$ ^2 B- J' ]謝謝分享 複製代碼就能使用嗎?
+ J' Q  t1 G3 ?' D( V並沒有 UserForm1 出現錯誤
- s. {1 `& c# p. f1 d/ ]

ryouss

hidingman 发表于 2018-5-21 12:57
謝謝分享 複製代碼就能使用嗎?
並沒有 UserForm1 出現錯誤

! L" l1 N7 A2 |4 `& S9 F* I/ _' S' hh大應該是沒寫過編程吧!
! g$ \  R* V' R3 L3 R# |" P貼上的是主要的計算構思,沒包含UserForm裡的物件,所以無法執行的.
希望會編程的,用簡版轉成完整的程式再分享有需要者.

keilei001

很酷，很高深。

qiminger

ryouss 发表于 2018-5-21 13:19
h大應該是沒寫過編程吧!
貼上的是主要的計算構思,沒包含UserForm裡的物件,所以無法執行的.
希望會編程 ...

- X9 P1 W/ v4 Y5 S3 o按梁老师要求已转成简体，现供论坛上的朋友测试。
圆周分布钻孔.rar (37.36 KB, 下载次数: 26)

2018-5-22 09:29 上传

点击文件名下载附件



4 n( b4 J8 C9 G# l8 E9 f( u: r
% U, a$ u& y) @/ q. n5 Z. d

: a/ u6 h+ J: O4 |4 u2 n7 ~
5 @! O) `8 o$ H* ?

ryouss

+ U3 L; O* q2 ^3 j$ Q8 Q% x. A

qiminger 发表于 2018-5-22 09:30
按梁老师要求已转成简体，现供论坛上的朋友测试。

! E7 }& J" K+ d/ J7 Y. h4 k非常感激,2012版試了正常(Userform1之圖像X座標反向了),補充注意事項:
3 M0 [' G: q- {3 b6 h& x, i
' 功能:圓周分佈鉆孔,本範例因是用除料拉伸,所以鉆孔是平底.
$ I$ ^9 @# _3 q! k1 D' 操作: 1.在零件先選取要鉆孔之平面.
$ E1 U* t# H1 B0 s3 f: x'          2.執行 "main" .
2 I5 r) p9 E' ~) m; X7 l+ P: d'          3.X座標取正數,若是負數可能會出錯.
'         4.首圈半徑近似於相鄰兩孔之中心距離.

' g! ^% V/ C* Y2 t3 L* f# D( I

ryouss

如圖X為-31,以4做偏移時為 4 8 12 16 20 24 28 32 36....
$ @" @& w0 @/ j9 ]/ d. N! n而就是在接近 31 的原點 28 32 這兩圈會出錯,不知有否解決方法?
! Y1 I* _) Z) [2 s  R
: n  [, t( \1 W: a! Z* H5 s
6 r" U$ I/ F2 a& z% \: l

5 m, A% H% Y6 J. j  F9 `" {
8 A4 {, R8 R4 k7 D

hidingman

qiminger 发表于 2018-5-22 09:30
6 r) G# R6 B' G0 D" \8 v按梁老师要求已转成简体，现供论坛上的朋友测试。

謝謝分享  但為什麼有時候又無法正常執行呢?

ryouss

hidingman 发表于 2018-5-23 13:00
謝謝分享  但為什麼有時候又無法正常執行呢?

) g- }6 U- @$ T6 W7 x7 UIf .TextBox4.Value <= .TextBox3.Value Or .TextBox1.Value = "" Or .TextBox2.Value = ""Or .TextBox3.Value = "" Or .TextBox4.Value = "" _
' B* \9 e  N8 A- B! F; `      Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then

1. X=0,Y=0 因如上程式把  TextBox1.Value及 TextBox2.Value 的 0 值當成"空資料"了,所以跑出提示"Data error Or Data empty".
2 ?7 a& a0 e! ~. B+ m2 L2. 可以把如上程式的  .TextBox1.Value = "" Or .TextBox2.Value = ""Or  刪除.
3. 但是測試結果當 X=0,Y=0 時,原點上做鉆孔直徑3的圆又沒畫出,這也是一個瓶頸(試了鉆孔直徑大於等於6.5就可以,莫名其妙??)!
5 ]0 \6 a3 r1 |! J1 `" [
; A0 P( x8 I% I修改測試后之結果煩請回知.

ryouss

hidingman 发表于 2018-5-23 13:00
謝謝分享  但為什麼有時候又無法正常執行呢?

- G! c- o3 b  E" k' A昨晚較有時間再測試分析,判定不是0與"空值"的問題,是 TextBox3(鉆孔直徑)及 TextBox4(首圈半徑)的判斷出問題.
  Q' Z' j0 @) q3 S: D) M因把 TextBox3 及 TextBox4 的值當作"文本"資料型態了,
  \7 v- p* ]$ x1 e3 `數值型態 8 肯定比 10 小,若是"文本"資料型態 "8" 就比 "10" 大了.
所以"判定資料是否沒打入或是輸入有誤"之程式修改為
- ]3 [  P$ |; h; x% q8 K; R
'判定資料是否沒打入
If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Or .TextBox6.Value = "" Then
  i9 u: l; c/ W& ]& e0 ?. g      MsgBox ("Enter empty")
- j, d' W/ X/ P      Exit Sub
End If
4 z0 }2 |% l$ S1 W'判定資料是否是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑)
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
) ~1 q9 U3 g- q8 A- ?; [- _* E
/ T+ p6 o1 l. {% Z9 f( J6 \
- U/ n$ V: T: h# V: v) |附上修正檔   Circle distribution_0524.rar (38.33 KB, 下载次数: 12)

2018-5-24 09:23 上传

点击文件名下载附件 swp文件

hidingman

ryouss 发表于 2018-5-24 09:23
+ }( r1 I% _; j1 b: j昨晚較有時間再測試分析,判定不是0與"空值"的問題,是 TextBox3(鉆孔直徑)及 TextBox4(首圈半徑)的判斷出 ...

8 A7 t# Z  q/ y0 |謝謝分享

keilei001

我工作的重点已经转移，没时间没精力再去学习SW和宏了。