ryouss 发表于 2019-6-16 14:38:32

在球体佈滿凸點-宏應用

參考



zhjan518 发表于 2019-6-24 15:03:13

可以分享一下吗:P

James924 发表于 2019-6-24 15:30:23

这个是什么?

ryouss 发表于 2019-6-24 21:14:06

zhjan518 发表于 2019-6-24 15:03
可以分享一下吗


附原文件 SW2012 及 SWP

操作說明:   在3D草圖執行 main 宏





' ******************************************************************************
'
' macro recorded on 06/15/19 by scliang
' Spherical make full of bumps
'
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim skPoint As Object
Dim d1 As Object
Dim d2 As Object
Part.SketchManager.AddToDB True
Set d1 = Part.Parameter("D1@Sketch1") '球體直徑
Set d2 = Part.Parameter("D1@3DSketch1") '凸點直徑
d1.SystemValue = InputBox("Key in the sphere diameter ", "Key in the parameters", 0.06)
d2.SystemValue = InputBox("Key in the bump diameter ", "Key in the parameters", 0.006)

'~~~ 點作圖 ~~~

pi = Atn(1) * 4
S = d1.SystemValue * pi / 2 '球體半圓弧長
N1 = IIf(Int(S / d2.SystemValue) / 2 = Int(S / d2.SystemValue / 2), Int(S / d2.SystemValue) - 1, Int(S / d2.SystemValue)) '球體半圓等分個數,需是奇數
A1 = pi / N1 '球體半圓等分弧度
Debug.Print "Number of each layer" '每層的個數
For i = 1 To N1 - 1
    Yi = d1.SystemValue / 2 * Cos(A1 * i) '點的Y座標
    Ri = d1.SystemValue / 2 * Sin(A1 * i) '剖切圓半徑
    N2 = Int(Ri * 2 * pi / d2.SystemValue) '剖切圓等分個數
    Total_Number = Total_Number + N2
    Debug.Print N2
    A2 = 2 * pi / N2
    For j = 0 To N2 - 1
      Xj = Ri * Cos(A2 * j)
      Zj = Ri * Sin(A2 * j)
      Set skPoint = Part.SketchManager.CreatePoint(Xj, Yi, Zj)
    Next j
Next i
Part.SketchManager.AddToDB False
boolstatus = Part.EditRebuild3()
MsgBox ("Total number of convex points==> " & Total_Number + 2) '對話表顯示凸點之總數
End Sub






ryouss 发表于 2019-6-24 21:15:05

zhjan518 发表于 2019-6-24 15:03
可以分享一下吗


附原文件 SW2012 及 SWP

操作說明:   在3D草圖執行 main 宏





' ******************************************************************************
'
' macro recorded on 06/15/19 by scliang
' Spherical make full of bumps
'
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim skPoint As Object
Dim d1 As Object
Dim d2 As Object
Part.SketchManager.AddToDB True
Set d1 = Part.Parameter("D1@Sketch1") '球體直徑
Set d2 = Part.Parameter("D1@3DSketch1") '凸點直徑
d1.SystemValue = InputBox("Key in the sphere diameter ", "Key in the parameters", 0.06)
d2.SystemValue = InputBox("Key in the bump diameter ", "Key in the parameters", 0.006)

'~~~ 點作圖 ~~~

pi = Atn(1) * 4
S = d1.SystemValue * pi / 2 '球體半圓弧長
N1 = IIf(Int(S / d2.SystemValue) / 2 = Int(S / d2.SystemValue / 2), Int(S / d2.SystemValue) - 1, Int(S / d2.SystemValue)) '球體半圓等分個數,需是奇數
A1 = pi / N1 '球體半圓等分弧度
Debug.Print "Number of each layer" '每層的個數
For i = 1 To N1 - 1
    Yi = d1.SystemValue / 2 * Cos(A1 * i) '點的Y座標
    Ri = d1.SystemValue / 2 * Sin(A1 * i) '剖切圓半徑
    N2 = Int(Ri * 2 * pi / d2.SystemValue) '剖切圓等分個數
    Total_Number = Total_Number + N2
    Debug.Print N2
    A2 = 2 * pi / N2
    For j = 0 To N2 - 1
      Xj = Ri * Cos(A2 * j)
      Zj = Ri * Sin(A2 * j)
      Set skPoint = Part.SketchManager.CreatePoint(Xj, Yi, Zj)
    Next j
Next i
Part.SketchManager.AddToDB False
boolstatus = Part.EditRebuild3()
MsgBox ("Total number of convex points==> " & Total_Number + 2) '對話表顯示凸點之總數
End Sub






zhjan518 发表于 2019-6-27 17:13:54

ryouss 发表于 2019-6-24 21:14
附原文件 SW2012 及 SWP

操作說明:   在3D草圖執行 main 宏


非常感谢!!!

ryouss 发表于 2019-6-27 20:28:10

zhjan518 发表于 2019-6-27 17:13
非常感谢!!!

請回報執行是否正常?


zhjan518 发表于 2019-7-24 20:26:37

ryouss 发表于 2019-6-27 20:28
請回報執行是否正常?

正常运行,幸苦了

tianma 发表于 2019-7-30 15:08:41

这个厉害,赞一个
页: [1]
查看完整版本: 在球体佈滿凸點-宏應用