方圆孔圆周分布-宏

wl840404

這是如上的升級版,圆孔圆周分布沒問題后想再試試正方孔,結果還是出現一些無法理解的問題.
有興趣者試試了,看是否能修改程式改善問題.
附SWP檔 Circle distribution_0527 - X1.rar (41.6 KB, 下载次数: 28)

2018-5-29 14:14 上传

点击文件名下载附件
下载积分: 金币 -1

' *************************************************************
' macro recorded on 05/20/28 by scliang
' 功能:圓周分佈方圓孔,本範例因是用除料拉伸,所以鉆孔是平底.
' 操作: 1.在零件先選取要打孔之平面.
' 2.執行 "main" .
' 3.TextBox 鍵入相關參數值.
' 4.首圈半徑近似於相鄰兩孔之中心(弧長)距離.
' 5.方孔邊長=圓孔直徑.
'
' *************************************************************

Dim A1X As Double 'TextBox1
Dim A1Y As Double 'TextBox2
Dim A2X As Double
Dim A3X As Double
Dim A3Y As Double
Dim B1X As Double
Dim B1Y As Double
Dim B2X As Double
Dim B2Y As Double
Dim B3X As Double
Dim B3Y As Double
Dim D As Double 'TextBox3
Dim R1 As Double 'TextBox4
Dim Drill_depth As Double 'TextBox5
Dim Circle_number As Integer 'TextBox6
Dim i As Integer
Dim Class_ As Integer
Dim pi As Double
Dim RN As Double
Dim ArcRadius As Double
Dim ArcAngle As Double

Sub main()
UserForm1.Show 0
End Sub

Sub Draw()
With UserForm1
Class_ = .ComboBox1.ListIndex '孔類代碼 0-->圓孔,1-->方孔
'判定資料是否沒打入
If .TextBox1.value = "" Or .TextBox2.value = "" Or .TextBox3.value = "" Or .TextBox4.value = "" Or .TextBox5.value = "" Or .TextBox6.value = "" Then
MsgBox ("Enter empty")
Exit Sub
End If
'判定資料是否是輸入錯誤(起始圓半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.5倍)
D = .TextBox3.value / 1000 '孔直徑=方孔邊長
R1 = .TextBox4.value / 1000 '首圈中心半徑
If (Class_ = 0 And D >= R1) Or (Class_ = 1 And R1 / D < 1.4999) Then
MsgBox ("Data error")
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