|
|
经典图书
1. 這是如上的升級版,在 pyczt大大 的指導下改進了不管XY為正負值或是0皆可執行,
並新增加打方孔.
2. 個人覺得宏的執行功能在应用上是較為其次,反而是給新入門有心學習宏的是不錯的範例.
3. 可能尚有其他未發現問題有興趣者試試了.
注意事項:
1.首圈半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.5倍(避免破孔或是零厚度).
2.草圖上不要用網格,避免取點時被吸附至網點.
附SWP文件
Circle distribution_0530.rar
(48.83 KB, 下载次数: 224, 售价: 30 金币)
- ' *************************************************************
- ' macro recorded on 05/28/18 by scliang
- ' 功能:圓周分佈方圓孔,本範例因是用除料拉伸,所以鉆孔是平底.
- ' 操作:1.在零件先選取要打孔之平面.
- ' 2.執行 "main" .
- ' 3.選取打孔類別,TextBox(文本框)鍵入相關參數值.
- ' 4.首圈半徑近似於相鄰兩孔之中心(弧長)距離.
- ' 5.方孔邊長=圓孔直徑.
- ' 注意事項:起始圓半徑限制不能小於等於鉆孔直徑,也不能小於方孔邊長的1.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
- .Label8.Caption = ""
- Class_ = .ComboBox1.ListIndex '孔類代碼 0-->圓孔,1-->方孔
- '判定資料是否沒打入
- If .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#) '中心方孔
- '~~~ 約束共點之初值 ~~~
- Dim NamePoint As String
- Dim NumPoint As Integer
- If A1X = 0 And A1Y = 0 Then
- NumPoint = 6
- Else
- NumPoint = 5
- End If
- '~~~~~~~~~~~~~~~~~
- 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) '複製數
- Debug.Print copy_number
- NumPoint = NumPoint + 5 * copy_number + 1 '點計數
- Totle_drill_hole = Totle_drill_hole + copy_number
- boolstatus = swSketchMgr.CreateCircularSketchStepAndRepeat(ArcRadius, ArcAngle, copy_number, 2 * pi, False, "", False, False, False)
- NamePoint = "Point" & NumPoint
- 'Debug.Print NamePoint
- Part.Extension.SelectByID2 NamePoint, "SKETCHPOINT", 0, 0, 0, False, 0, Nothing, 0 '圓周複製中心點
- Part.Extension.SelectByID2 "Point1", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0 '輸入的XY座標點
- Part.SketchAddConstraints "sgCOINCIDENT" '取圓周複製中心點和輸入的XY座標點 "共點約束"
- Part.ClearSelection2 True
- 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-31 09:22:33
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
楼主
鲁公网安备 37028502190335号