QQ登录

只需一步,快速开始

登录 立即注册

在球体佈滿凸點-宏應用

[复制链接]
查看: 459|回复: 8
ryouss 发表于 2019-6-16 14:38:32
參考


160303.gif
zhjan518 发表于 2019-6-24 15:03:13
可以分享一下吗
James924 发表于 2019-6-24 15:30:23
这个是什么?
楼主  ryouss 发表于 2019-6-24 21:14:06


附原文件 SW2012 及 SWP   ball-point.rar (798.72 KB, 下载次数: 33)
楼主  ryouss 发表于 2019-6-24 21:15:05


附原文件 SW2012 及 SWP  

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





  1. ' ******************************************************************************
  2. '
  3. ' macro recorded on 06/15/19 by scliang
  4. ' Spherical make full of bumps
  5. '
  6. ' ******************************************************************************
  7. Dim swApp As Object
  8. Dim Part As Object
  9. Dim boolstatus As Boolean

  10. Sub main()
  11. Set swApp = Application.SldWorks
  12. Set Part = swApp.ActiveDoc
  13. Dim skPoint As Object
  14. Dim d1 As Object
  15. Dim d2 As Object
  16. Part.SketchManager.AddToDB True
  17. Set d1 = Part.Parameter("D1@Sketch1") '球體直徑
  18. Set d2 = Part.Parameter("D1@3DSketch1") '凸點直徑
  19. d1.SystemValue = InputBox("Key in the sphere diameter [Unit:m]", "Key in the parameters", 0.06)
  20. d2.SystemValue = InputBox("Key in the bump diameter [Unit:m]", "Key in the parameters", 0.006)

  21. '~~~ 點作圖 ~~~

  22. pi = Atn(1) * 4
  23. S = d1.SystemValue * pi / 2 '球體半圓弧長
  24. N1 = IIf(Int(S / d2.SystemValue) / 2 = Int(S / d2.SystemValue / 2), Int(S / d2.SystemValue) - 1, Int(S / d2.SystemValue)) '球體半圓等分個數,需是奇數
  25. A1 = pi / N1 '球體半圓等分弧度
  26. Debug.Print "Number of each layer" '每層的個數
  27. For i = 1 To N1 - 1
  28.     Yi = d1.SystemValue / 2 * Cos(A1 * i) '點的Y座標
  29.     Ri = d1.SystemValue / 2 * Sin(A1 * i) '剖切圓半徑
  30.     N2 = Int(Ri * 2 * pi / d2.SystemValue) '剖切圓等分個數
  31.     Total_Number = Total_Number + N2
  32.     Debug.Print N2
  33.     A2 = 2 * pi / N2
  34.     For j = 0 To N2 - 1
  35.         Xj = Ri * Cos(A2 * j)
  36.         Zj = Ri * Sin(A2 * j)
  37.         Set skPoint = Part.SketchManager.CreatePoint(Xj, Yi, Zj)
  38.     Next j
  39. Next i
  40. Part.SketchManager.AddToDB False
  41. boolstatus = Part.EditRebuild3()
  42. MsgBox ("Total number of convex points==> " & Total_Number + 2) '對話表顯示凸點之總數
  43. 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-7-24 20:26:37
ryouss 发表于 2019-6-27 20:28
請回報執行是否正常?

正常运行,幸苦了
tianma 发表于 2019-7-30 15:08:41
这个厉害,赞一个
http://fans.SolidWorks.com.cn/blog/?387
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|手机版|小黑屋|京ICP备11009482号-2  

400 - 818 - 3535 (中国地区咨询电话) | 达索析统(上海)信息技术有限公司北京分公司

京ICP备11009482号-2 | 电话:01065362288

北京市朝阳区建国路79号华贸中心2号写字楼707-709室,邮编:100025

GMT+8, 2019-10-24 02:25 , Processed in 0.153371 second(s), 37 queries .

Copyright © 2002-2018 Dassault Systèmes - All rights reserved

快速回复 返回顶部 返回列表