iCAx开思网

标题: 一键删除边界框的宏 [打印本页]
作者: qxzch    时间: 2017-6-11 11:20
标题: 一键删除边界框的宏
录制了一个一键删除边界框的宏，代码如下。这个宏只能对应删除切割清单项目1～15的边界框，超出范围的删不了，当然笨办法是有：一直从切割清单项目1列到切割清单项目100、1000等，所以，想搞一个循环语句遍历所有的切割清单项目，苦于编程水平太差，求论坛各位高手指教，谢谢！
  1. Dim swApp As Object

  3. Dim Part As Object
  4. Dim boolstatus As Boolean
  5. Dim longstatus As Long, longwarnings As Long

  7. Sub main()

  9. Set swApp = Application.SldWorks

  11. Set Part = swApp.ActiveDoc
  12. boolstatus = Part.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
  13. Part.ClearSelection2 True
  14. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目1", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  15. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目2", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  16. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目3", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  17. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目4", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  18. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目5", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  19. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目6", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  20. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目7", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  21. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目8", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  22. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目9", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  23. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目10", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  24. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目11", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  25. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目12", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  26. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目13", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  27. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目14", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  28. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目15", "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  29. Part.EditDelete
  30. End Sub
复制代码


作者: 莱虫    时间: 2017-6-11 18:10
不太明白楼主的意图，随手改下，可能不是楼主想要的。
  1. Dim swApp As Object

  3. Dim Part As Object
  4. Dim boolstatus As Boolean
  5. Dim longstatus As Long, longwarnings As Long
  6. Dim i As Integer

  8. Sub main()

  10. Set swApp = Application.SldWorks

  12. Set Part = swApp.ActiveDoc
  13. boolstatus = Part.Extension.SelectByID2("实体", "BDYFOLDER", 0, 0, 0, False, 0, Nothing, 0)
  14. Part.ClearSelection2 True
  15. For i = 1 to 1000
  16. boolstatus = Part.Extension.SelectByID2("边界框_切割清单项目" & i, "SKETCH", 0, 0, 0, True, 0, Nothing, 0)
  17. Next
  18. Part.EditDelete
  19. End Sub
复制代码

作者: qxzch    时间: 2017-6-11 21:48
莱虫 发表于 2017-6-11 18:10
不太明白楼主的意图，随手改下，可能不是楼主想要的。

谢谢莱大提供的代码！使用一切正常，太感谢啦




欢迎光临 iCAx开思网 (https://www.icax.org/) Powered by Discuz! X3.3