【遍歷宏】在總裝配內零件的自定義屬性寫入配套數量（開放代碼）最新版本在122樓

相關討論：
https://www.icax.org/thread-755962-1-1.html
https://www.3dportal.cn/discuz/forum.php?mod=viewthread&tid=1434418&extra=page%3D1

例子“整套微型電控銑床裝配”的下載地址：
https://www.3dportal.cn/discuz/forum.php?mod=viewthread&tid=1427631

經過深思熟慮，悶人從自己一直用開及冗長不堪的宏中精簡出以下代碼：

游客，如果您要查看本帖隐藏内容请回复

鄭重聲明：此宏不存在實時關聯，只是一次性的程序，倘若修改設計後，必須再運行一次。

歡迎討論，探討還有沒有更好方法解決問題。
就算逐句研習代碼的意義也絕對歡迎。

但謝絕帶指控性的發帖，
例如『有沒有必要呀？』、『这个是比较奇芭的用法』、『與標準相悖』，一律扣分。

不顶看不到东西，难怪论坛都是旧帖子上来

523491086 发表于 2017-6-3 17:36
那我称呼您丹大好了，我根据您的代码加进去以后，输入订单数量后，在零件属性里面没有相应的评估值，请看 ...

檢查一下代碼有沒有錯誤，我這邊測試是沒有問題的~

523491086 发表于 2017-6-5 10:03
丹大，您好，刚刚又回去仔细的看了一下代码，发现跟您的代码没有出入，找不到问题的所在？麻烦再指点一下 ...

指點不敢當，用的都是悶老大和萊大的代碼，我只是加加減減瞎湊和的。
回到主題，看來您並沒有"仔細"檢查代碼內容，所以忽略了其中不同的地方。

1. Dim TopDocPathOnly As String
   
2. Dim PartsCollect() As String '遍歷清單（陣列）
   
3. Dim InCollectCount As Double '遍歷清單長度
   
4. Dim CustomInfoQTY As String
   
5. Dim AssemQTY As String
   
6. Dim TotalQTY As String
   
7. 
   
8. Sub main()
   
9. Set swApp = Application.SldWorks 'SW對像
   
10. Set TopDoc = swApp.ActiveDoc '總裝對像
    
11. If TopDoc.GetType <> 2 Then Exit Sub '不是裝配=退出
    
12. TopDocPathSplit = Split(TopDoc.GetPathName, "") '分割
    
13. TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '總裝文件名稱
    
14. TopDocName = Left(TopDocName, Len(TopDocName) - 7) '總裝文件名稱（排除.SLDASM）
    
15. TopDocPathOnly = Mid(TopDoc.GetPathName, 1, InStrRev(TopDoc.GetPathName, "", -1)) '總裝的完整目錄
    
16. TopConfString = TopDoc.GetActiveConfiguration.Name '總裝配置名稱
    
17. CustomInfoQTY = "單機用量"
    
18. AssemQTY = InputBox("請輸入本次訂單數量：", "")
    
19. TotalQTY = "本次訂單總用量"
    
20. If CustomInfoQTY = "" Then Exit Sub '按下取消離開宏
    
21. InCollectCount = 1 '遍歷清單長度基數
    
22. ReDim PartsCollect(InCollectCount) '定義陣列項數
    
23. SubAsm TopDoc, TopConfString '遍歷
    
24. Beep
    
25. MsgBox "完成"
    
26. End Sub
    
27. 
    
28. Function SubAsm(AsmDoc, ConfString)
    
29. Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
    
30. Set RootComponent = Configuration.GetRootComponent
    
31. Components = RootComponent.GetChildren
    
32. For Each Child In Components
    
33.     Set ChildModel = Child.GetModelDoc
    
34.     If Not (ChildModel Is Nothing) Then '排除抑制及輕化
    
35.         ChildConfString = Child.ReferencedConfiguration '零件配置名稱
    
36.         ChildType = ChildModel.GetType
    
37.         ChildPathSplit = Split(Child.GetPathName, "") '分割
    
38.         ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名稱
    
39.         
    
40.         ChildPathOnly = Mid(Child.GetPathName, 1, InStrRev(Child.GetPathName, "", -1)) '零件的完整目錄
    
41.         If ChildPathOnly = Replace(ChildPathOnly, TopDocPathOnly, "") Then SamePath = False Else SamePath = True '零件是否在總裝目錄或往下目錄
    
42.         
    
43.         If SamePath And (Not Child.ExcludeFromBOM) And (Not Child.IsEnvelope) Then '跳過：不在總裝目錄或其往下目錄 或 不包括在材料明細表中 或 是個封套
    
44.             UNIT_OF_MEASURE = ChildModel.CustomInfo2(ChildConfString, "備用倍數")
    
45.             If (UNIT_OF_MEASURE = 0) Or (UNIT_OF_MEASURE = "") Then UNIT_OF_MEASURE = 1 '備用量除錯
    
46.             inCollect = False '重置判斷變量
    
47.             For Each PartinCollect In PartsCollect '判斷是否已在遍歷清單內
    
48.                 If ChildConfString & "@" & ChildName = PartinCollect Then inCollect = True
    
49.             Next
    
50.             If inCollect Then '已在遍歷清單內
    
51.                 ht_Qty = ChildModel.CustomInfo2(ChildConfString, CustomInfoQTY) + 1 * UNIT_OF_MEASURE
    
52.                 all_Qty = AssemQTY * ht_Qty
    
53.                 ChildModel.DeleteCustomInfo2 ChildConfString, CustomInfoQTY
    
54.                 ChildModel.AddCustomInfo3 ChildConfString, CustomInfoQTY, 30, ht_Qty
    
55.                 ChildModel.DeleteCustomInfo2 ChildConfString, "本次訂單數量"
    
56.                 ChildModel.AddCustomInfo3 ChildConfString, "本次訂單數量", 30, AssemQTY
    
57.                 ChildModel.DeleteCustomInfo2 ChildConfString, TotalQTY
    
58.                 ChildModel.AddCustomInfo3 ChildConfString, TotalQTY, 30, all_Qty
    
59.             Else '不在遍歷清單內（首次處理）
    
60.                 all_Qty = AssemQTY * UNIT_OF_MEASURE
    
61.                 ChildModel.DeleteCustomInfo2 ChildConfString, CustomInfoQTY
    
62.                 ChildModel.AddCustomInfo3 ChildConfString, CustomInfoQTY, 30, UNIT_OF_MEASURE
    
63.                 ChildModel.DeleteCustomInfo2 ChildConfString, "本次訂單數量"
    
64.                 ChildModel.AddCustomInfo3 ChildConfString, "本次訂單數量", 30, AssemQTY
    
65.                 ChildModel.DeleteCustomInfo2 ChildConfString, TotalQTY
    
66.                 ChildModel.AddCustomInfo3 ChildConfString, TotalQTY, 30, all_Qty
    
67.                 InCollectCount = InCollectCount + 1 '遍歷清單長度基數+1
    
68.                 ReDim Preserve PartsCollect(InCollectCount) '重新定義陣列項數（保留內含數據）
    
69.                 PartsCollect(InCollectCount - 1) = ChildConfString & "@" & ChildName '加入到遍歷清單中
    
70.                 ChildModel.SetUserPreferenceIntegerValue swUnitSystem, swUnitSystem_Custom '單位系統=Custom
    
71.             End If
    
72.             If ChildType = 2 Then
    
73.                 SubAsm ChildModel, ChildConfString '如果是裝配則向下遍歷
    
74.             End If
    
75.             
    
76.         End If
    
77.     End If
    
78. Next
    
79. End Function
    
80. 
    

复制代码

这是最新的吗？

wwggkk 发表于 2014-10-27 21:03
还不行啊，toolbox还是加了个“数量”属性

无需贴图的，文字表达就行，不会不信你的。
倒不如贴出你修改后的代码吧，这就可以更易帮你解决，

但不要贴图啊，要贴代码啊，还要隐藏呀！
语法是：
[ｈｉｄｅ]
[ｃｏｄｅ ]
....
....
...
修改后的代码
.....
........
..
[/code]
[/hide]

繁字体的帖子好多，这是为什么。

这个问题两个论坛讨论挺热烈，先学习学习闷大的技巧。

裝配體直觀功能的確不錯，但是會連同“封套”及“不包括在材料明細表中”的零件都一併計算，又沒有計算到“備用量”，出來的數量可能存在偏差。
甚麼是“備用量”呢？就是在自定義屬性中加上一個指定的倍數，可以用一個零件代表多個零件的方法。
相關討論：
https://www.solidworks.org.tw/forum.php?mod=viewthread&tid=16082

以下例子中，『機腳』容易在運輸時損壞，改為到現場才安裝又會出現跌丟的情況，由於不是標準件，一旦遺失或損壞，就要工場重做，頗為麻煩。只要在『機腳』零件加上相應的自定義屬性，BOM內的數量就會自動乘以這個倍數，例子的倍數是2，『機腳』數量就是8件了。不難發現，裝配體直觀功能是不會計算這個倍數的。

以下例子，
『110903-Ceiling_』只是吊頂的示意，
『110903-Ceiling_#』用來關聯數據，
兩者均從BOM排除了，但在“裝配體直觀”中依然存在數量。

操作過程。

來頂頂悶大的帖子，偶先去細細閱讀相關帖子先……

认真学习，谢谢闷大  {:soso_e163:}

感谢闷大无私奉献

感谢闷大无私奉献

回复后再学习，谢闷大分享。