變徑孔圓周複製-宏
本帖最后由 ryouss 于 2018-12-21 17:10 编辑參考 swp文件
' 孔徑變化之圓周複製 2018/12/17 SW2012-SP4 測試
'
<font color="#0000ff"><b>' ~~~ 提示 ~~~
' 1. 在零件選取作孔之平面
' 2. 執行 main宏.
' 3. 在 UserForm 鍵入數據.
' 4. 在 UserForm 按 "執行鍵".
' 5. 中心基孔定義在原點.</b></font>
Dim swApp As Object
Dim pi As Double
Dim R0 As Double
Dim HoleDiameterDiffer As Double
Dim CircllHoleEdge As Double
Dim CirclInsideHoleEdge As Double
Dim i, CircleNumber, CopyNunber, TotalCopyNunber As Integer
Dim Dn As Double
Dim Rn As Double
Dim XRn As Double
'~~~ 主程式 ~~~
Sub main()
UserForm1.Show 1
End Sub
'~~~ 作圖 ~~~
Sub Draw()
With UserForm1
'判定資料是否沒打入
If .TextBox1.Value = "" Or .TextBox2.Value = "" Or .TextBox3.Value = "" Or .TextBox4.Value = "" Or .TextBox5.Value = "" Then
MsgBox ("Enter empty")
Exit Sub
End If
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSketchMgr = Part.SketchManager
Part.SketchManager.InsertSketch True '依據選取面插入草圖
Part.SketchManager.AddToDB True'草圖實體直接添加到數據庫(否則 x<=0 會有問題)
pi = Atn(1) * 4 '圓周率
HoleDiameterDiffer = .TextBox2.Value / 1000 '各周孔直徑之差值
CircleNumber = .TextBox3.Value '周圈數
CircllHoleEdge = .TextBox4.Value / 1000 '周和周之孔邊間距
CirclInsideHoleEdge = .TextBox5.Value / 1000 '周圈內之孔邊間距
'原點中心圓作圖
R0 = .TextBox1.Value / 2000 '中心圓半徑
Set swSketchSegment = swSketchMgr.CreateCircle(0, 0, 0#, R0, 0, 0#) '作中心圓
.Label6.Caption = ""
TotalCopyNunber = 0
For i = 1 To CircleNumber
If .OptionButton1.Value = True Then '遞增
Dn = 2 * R0 + i * HoleDiameterDiffer '周圈之孔直徑
Rn = i * (2 * R0 + i * HoleDiameterDiffer / 2 + CircllHoleEdge) 'i 周圈之半徑
Else
If .OptionButton2.Value = True Then '遞減
Dn = 2 * R0 - i * HoleDiameterDiffer '周圈之孔直徑
Rn = i * (2 * R0 - i * HoleDiameterDiffer / 2 + CircllHoleEdge) 'i 周圈之半徑
Else
Dn = 2 * R0'周圈之孔直徑皆等
Rn = i * (2 * R0 + CircllHoleEdge)'i 周圈之半徑
End If
End If
CopyNunber = Int(2 * Rn * pi / (Dn + CirclInsideHoleEdge) + 0.5) '圓周分布之複製孔數
TotalCopyNunber = TotalCopyNunber + CopyNunber
XRn = Rn + Dn / 2
'Debug.Print Dn & "~~~" & Rn & "~~~" & CopyNunber
Set swSketchSegment = swSketchMgr.CreateCircle(Rn, 0, 0#, XRn, 0, 0#) '分布圓之基圓作圖
boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(Rn, pi, CopyNunber, 2 * pi, True, "", True, True, True) '圓周複製
Next i
.Label6.Caption = TotalCopyNunber + 1
End With
Part.SketchManager.AddToDB False
End Sub
感谢楼主分享！ 楼主为什么都是繁体字
这个比较好用了，值得推广。 值得推广
万华金属 303不锈钢制造 繁体字在台湾用的比较多 56145 代码看不懂，文件有吗？
一休小和尚S 发表于 2018-12-21 08:26
代码看不懂，文件有吗？
如何使用？
本帖最后由 ryouss 于 2018-12-21 17:12 编辑
一休小和尚S 发表于 2018-12-21 14:42
如何使用？
詳看 1#
[*]' 1. 在零件選取作孔之平面
[*]' 2. 執行 main宏.
[*]' 3. 在 UserForm 鍵入數據.
[*]' 4. 在 UserForm 按 "執行鍵".
[*]' 5. 中心基孔定義在原點.
页:
[1]
2