本帖最后由 ryouss 于 2018-5-30 09:37 编辑
https://www.icax.org/thread-1258414-1-1.html
這是如上的升級版,圆孔圆周分布沒問題后想再試試正方孔,結果還是出現一些無法理解的問題.
有興趣者試試了,看是否能修改程式改善問題.
附SWP檔
- ' *************************************************************
- ' 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<=0 會有問題)
- '中心圓之座標及作圖
- A1X = .TextBox1.value / 1000 '圓周複製中心 X 座標
- A1Y = .TextBox2.value / 1000 '圓周複製中心 Y 座標
- A2X = A1X + D / 2 '中心圓之半徑 X 座標
- pi = Atn(1) * 4
- Circle_number = .TextBox6.value '複製圈數
- Drill_depth = .TextBox5.value / 1000 '鉆孔深
- '判定孔類之圓周分佈打孔
- Select Case Class_
- Case 0 '打圓孔
- Set swSketchSegment = swSketchMgr.CreateCircle(A1X, A1Y, 0#, A2X, A1Y, 0#) '作中心圓
- For i = 1 To Circle_number
- RN = i * R1 '分佈圓周之半徑
- Copy_Number = Int(2 * RN * pi / R1 + 0.5) '分佈圓周之鉆孔數
- Totle_drill_hole = Totle_drill_hole + Copy_Number '累加各圈孔數
- '分佈圓之基圓作圖
- B1X = A1X + RN
- B2X = B1X + D / 2
- Set swSketchSegment = swSketchMgr.CreateCircle(B1X, A1Y, 0#, B2X, A1Y, 0#) '各圈基孔
- '分佈圓之複製孔數,圓周複製參數:圓弧半徑、圓弧角、複製數、孔間距(間隔弧度)、圖案旋轉、刪除實例
- boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(RN, pi, Copy_Number, 2 * pi, True, "", True, True, True)
- Next
- Case 1 '打方孔
- A3X = A1X - D / 2
- A3Y = A1Y + D / 2
- vSkLines = swSketchMgr.CreateCenterRectangle(A1X, A1Y, 0#, A3X, A3Y, 0#) '中心方孔
- 'Stop
- For i = 1 To Circle_number
- '中心圓之座標及作圖
- RN = i * R1 '分佈圓周之半徑
- B1X = A1X + RN
- B1Y = A1Y
- B3X = B1X - D / 2
- B3Y = A3Y
- vSkLines = swSketchMgr.CreateCenterRectangle(B1X, B1Y, 0, B3X, B3Y, 0) '各圈基準方孔
- ArcAngle = pi - Atn(D / 2 / (RN - D / 2)) '圓周複製弧角
- ArcRadius = Sqr((D / 2) ^ 2 + (RN - D / 2) ^ 2) '圓周複製半徑
- Copy_Number = Int(2 * RN * pi / R1 + 0.5) '複製數
- Totle_drill_hole = Totle_drill_hole + Copy_Number
- boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(ArcRadius, ArcAngle, Copy_Number, 2 * pi, False, "", False, False, False)
- Next
- End Select
- .Label8.Caption = 1 + Totle_drill_hole '總鉆孔數
- End With
- Part.SketchManager.AddToDB False
- '除料拉伸
- Dim myFeature As Object
- Set myFeature = Part.FeatureManager.FeatureCut3(True, False, False, 0, 0, Drill_depth, 0, False, False, False, False, 1.74532925199433E-02, _
- 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False)
- End Sub
失敗(測試時圖形過小也容易失敗)
|
发表于 2018-5-29 14:14:07
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
淘帖
赞一下！
发表于 2018-5-30 15:53:52
