變徑孔圓周複製（变径孔圆周复制）

ryouss

變徑孔圓周分布.rar (11.61 KB, 下载次数: 36, 售价: 35 金币)

2018-12-17 19:06 上传

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

swp

1. '   變徑孔圓周複製 2018/12/17 2012-sp4測試ok
   
2. '
   
3. '   1. 在零件選取作孔之平面
   
4. '   2. 執行 main宏.
   
5. '   3. 在 UserForm 鍵入數據.
   
6. '   4. 在 UserForm 按 "執行鍵".
   
7. '
   
8. 
   
9. Dim swApp As Object
   
10. Dim pi As Double
    
11. Dim R0 As Double
    
12. Dim HoleDiameterDiffer As Double
    
13. Dim CircllHoleEdge As Double
    
14. Dim CirclInsideHoleEdge As Double
    
15. Dim i, CircleNumber, CopyNunber As Integer
    
16. Dim Dn As Double
    
17. Dim Rn As Double
    
18. Dim XRn As Double
    
19. 
    
20. Sub main()
    
21. UserForm1.Show 1
    
22. End Sub
    
23. 
    
24. Sub Draw()
    
25. 
    
26. With UserForm1
    
27. '判定資料是否沒打入
    
28. If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Then
    
29.       MsgBox ("Enter empty")
    
30.       Exit Sub
    
31. End If
    
32. Set swApp = Application.SldWorks
    
33. Set Part = swApp.ActiveDoc
    
34. Set swSketchMgr = Part.SketchManager
    
35. Part.SketchManager.InsertSketch True '依據選取面插入草圖
    
36. Part.SketchManager.AddToDB True  '草圖實體直接添加到數據庫(否則 x<=0 會有問題)
    
37. 
    
38. pi = Atn(1) * 4 '圓周率
    
39. HoleDiameterDiffer = .TextBox2.Value / 1000 '各周孔直徑之差值
    
40. CircleNumber = .TextBox3.Value '周圈數
    
41. CircllHoleEdge = .TextBox4.Value / 1000 '周和周之孔邊間距
    
42. CirclInsideHoleEdge = .TextBox5.Value / 1000 '周圈內之孔邊間距
    
43. '原點中心圓作圖
    
44. R0 = .TextBox1.Value / 2000 '中心圓半徑
    
45. Set swSketchSegment = swSketchMgr.CreateCircle(0, 0, 0#, R0, 0, 0#) '作中心圓
    
46. 'Stop
    
47. For i = 1 To CircleNumber
    
48.     Dn = 2 * R0 + i * HoleDiameterDiffer '周圈之孔直徑
    
49.     Rn = i * (2 * R0 + i * HoleDiameterDiffer / 2 + CircllHoleEdge) 'i 周圈之半徑
    
50.     CopyNunber = Int(2 * Rn * pi / (Dn + CirclInsideHoleEdge) + 0.5) '圓周分布之複製孔數
    
51.     XRn = Rn + Dn / 2
    
52. Debug.Print Dn & "~~~" & Rn & "~~~" & CopyNunber
    
53.     Set swSketchSegment = swSketchMgr.CreateCircle(Rn, 0, 0#, XRn, 0, 0#) '分布圓之基圓作圖
    
54.     boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Rn, pi, CopyNunber, 2 * pi, True, "", True, True, True) '圓周複製
    
55. Next i
    
56. End With
    
57. Part.SketchManager.AddToDB False
    
58. End Sub
    

复制代码

hdgd501

感谢楼主分享，很不错！楼主太有才了，膜拜中……

xiao654321

很不错，顶一下！

benjujieshu

感谢楼主分享，很不错！

wolozihan

   经典案例图书

能不能弄成简体版的啊，只要是繁体字的就不能用。

ryouss

wolozihan 发表于 2018-12-26 20:47
能不能弄成简体版的啊，只要是繁体字的就不能用。

繁体版可用的

wolozihan

   经典案例图书

ryouss 发表于 2018-12-27 11:59
繁体版可用的

谢谢你的回复，我是SW18版的，加载后出现Enter empty

ryouss

wolozihan 发表于 2018-12-27 19:14
谢谢你的回复，我是SW18版的，加载后出现Enter empty

如圖依順序操作

wwwerzhou

矩形面能用这个吗？？？

龙潜四海

楼主，你给的压缩包是啥来的，我怎么打不开

liyuyin007

楼主辛苦了！

平凡简单

菜鸟表示 完全看不懂