一键删除边界框的宏

qxzch

录制了一个一键删除边界框的宏，代码如下。这个宏只能对应删除切割清单项目1～15的边界框，超出范围的删不了，当然笨办法是有：一直从切割清单项目1列到切割清单项目100、1000等，所以，想搞一个循环语句遍历所有的切割清单项目，苦于编程水平太差，求论坛各位高手指教，谢谢！

1. Dim swApp As Object
   
2. 
   
3. Dim Part As Object
   
4. Dim boolstatus As Boolean
   
5. Dim longstatus As Long, longwarnings As Long
   
6. 
   
7. Sub main()
   
8. 
   
9. Set swApp = Application.SldWorks
   
10. 
    
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

复制代码

莱虫

qxzch