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

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

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

gt.adan 发表于 2017-6-5 09:00
檢查一下代碼有沒有錯誤，我這邊測試是沒有問題的~

丹大，您好，刚刚又回去仔细的看了一下代码，发现跟您的代码没有出入，找不到问题的所在？麻烦再指点一下，谢谢。。或者可以直接传一个宏文件给我看看吗

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. 
    

复制代码

gt.adan 发表于 2017-6-5 10:59
指點不敢當，用的都是悶老大和萊大的代碼，我只是加加減減瞎湊和的。
回到主題，看來您並沒有"仔細"檢查 ...

，丹大威武，问题解决了，真的非常感谢这么多天丹大一直关注我的问题,祝丹大烦恼少少，生活有滋味，另外也祝开思越办越好
PS:不过不知道什么原因我直接把丹大的代码拿过来用是有问题的，这次真的是再仔细的核对与闷大和莱大的代码，然后整合了一下，我最终也成功了。噢耶

523491086 发表于 2017-6-5 13:28
，丹大威武，问题解决了，真的非常感谢这么多天丹大一直关注我的问题,祝丹大烦恼少少，生活 ...

我想，錯誤多半是繁體簡體所致。
總之，問題解決了就好~

gt.adan 发表于 2017-6-5 14:40
我想，錯誤多半是繁體簡體所致。
總之，問題解決了就好~

问题解决了就好了

为楼主钻研的精神鼓励

真是帮了大忙！！！！楼主威武！上次对零件连续工作15个小时！

wwggkk 发表于 2014-10-28 19:11
可以了，非常感谢{:soso_e181:}

为什么我的不行啊能不能发个宏文件啊

感谢分享，楼主厉害，