数量统计与图号分离的新思路

        闷大版主分享的数量统计宏使用非常方便，但在实际使用中（经本人测试），一个大型的装配文件（20000+模型）运行宏至少要50分钟以上，如果电脑配置不好的情况下可能时间会更长。因此经过测试后，发现问题的所在：原因是当遍历到一个模型时，会进入属性去改写属性，如果这个模型在这个装配体中出现100次，则会100次去改写同一个模型的属性，如果出现次数越多，读取和写入的次数也就越多，这样在零件数量非常大的时候运行效率会降低。本人经过用GetComponents方法只须遍历装配模型两次即可统计数量，一次统计数量，第二次写入属性。而且可以方便的把分离图号也加进去。经测试，同样的装配文件（20000+），宏文件运行50分钟以上，而新的工具只要5分钟左右。

很编程软件很历害。。。楼主共享出来啊，让这工具越来越好用，造福大家。

shentu 发表于 2020-3-8 21:34
很编程软件很历害。。。楼主共享出来啊，让这工具越来越好用，造福大家。

有更好的方法，可以大家一起看看。

我一直在用这个宏，不过加入图号分离不需要了

         其实代码都是差不多，只是方法不一样，用GetComponents只是不用递归调用，只遍历就行。主要的是用字典存储数量信息，第一次遍历存储统计的数量信息，第二次遍历将统计的数量写入模型。因本人不会VBA所以只能提供VB.NET代码，此代码不完整，仅供参考：

1.       '统计数量
   
2. 
   
3.      For i = 0 To swChidren.Length - 1
   
4.             swCom = swChidren(i)
   
5.             If swCom.IsVirtual Then
   
6.                 Continue For
   
7.             End If
   
8.             If swCom.IsSuppressed Then
   
9.                 Continue For
   
10.             End If
    
11.             If swCom.ExcludeFromBOM Then
    
12.                 Continue For
    
13.             End If
    
14.             swGetPathName = swCom.GetPathName.ToUpper
    
15.             swcomKey = swComDict.ContainsKey(swGetPathName)
    
16.             If swcomKey = False Then
    
17.                 'TextBox1.AppendText(vbCrLf & swGetPathName)
    
18.                 swComDict.Add(swGetPathName, swComtmp)
    
19.             Else
    
20.                 swComtmps = swComDict.Item(swGetPathName) + 1
    
21.                 swComDict.Item(swGetPathName) = swComtmps
    
22.             End If
    
23.         Next
    
24. 
    
25.      '写入数量
    
26. 
    
27.      For j = 0 To swChidren.Length - 1
    
28.             swCom = swChidren(j)
    
29.             If swCom.IsVirtual Then
    
30.                 Continue For
    
31.             End If
    
32.             If swCom.IsSuppressed Then
    
33.                 Continue For
    
34.             End If
    
35.             If swCom.ExcludeFromBOM Then
    
36.                 Continue For
    
37.             End If
    
38.             Dim swToNama As String
    
39.             Dim swTopDocName As String
    
40.             Dim swReplaceName As String
    
41.             Dim swTopPCode As String
    
42.             Dim swTopPName As String
    
43.             Dim swConfigName As String         
    
44. 
    
45.             swConfigName = swCom.ReferencedConfiguration
    
46.             swGetPathName = swCom.GetPathName.ToUpper
    
47.             swPathSplit = Split(swGetPathName, "")
    
48.             swToNama = swPathSplit(UBound(swPathSplit))
    
49.             swTopDocName = Microsoft.VisualBasic.Left(swToNama, Len(swToNama) - 7)
    
50.             Label1.Text = "打开模型："
    
51.             Label12.Text = swGetPathName
    
52.             swContains = swMocName.Contains(swGetPathName)
    
53.             If swContains = True Then
    
54.                 Continue For
    
55.             Else
    
56.                 curNode = rootNode.Nodes.Add(swTopDocName)
    
57.                 swcomModel = swCom.GetModelDoc2
    
58.                 swMocName.Add(swGetPathName)
    
59.                 swComtmpa = swComDict.Item(swGetPathName)
    
60.                 If RadioButton3.Checked = True Then
    
61.                     swPropMgr = swcomModel.Extension.CustomPropertyManager("")
    
62.                 Else
    
63.                     swPropMgr = swcomModel.Extension.CustomPropertyManager(swConfigName)
    
64.                 End If
    
65.                 If RadioButton7.Checked = True Then                  
    
66.                     swPropMgr.Add3(CustomInfoQTY, 30, swComtmpa, 1)
    
67.                     If RadioButton11.Checked = True Then
    
68.                         swPropMgr.Add3(CustomInfoTTY, 30, Couu, 1)                       
    
69.                     End If
    
70.                 End If            
    
71.            
    
72.             End If
    
73.             swcomModel.Save()
    
74.         Next

复制代码

可以分享下吗

楼主好方法！

希望有vba高手整理出宏分享上来给大家用，vb.net须打包后才能使用，我这个工具还有一些功能没有完善，现在还没有打包发行，所以暂时不能分享给大家。

谢谢

感谢楼主,谢谢分享