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

好东西,谢谢分享!!!

找了好久，终于找到了

学习学习....

我写的程序，程序很短，思路是将SW的BOM表导入到EXCEL，然后将EXCEL的数据（零件名+数量）写入到字典，然后通过文件名来匹配到字典里存的数据（数量）写入到零件的数量属性。其中提示请输入数据时需要粘帖数据进来。Myr = 500 '需人工设定

Sub main()
'打开EXCEL表格开始
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = True
'结束

'填入数据开始
Dim d
Set d = CreateObject("Scripting.Dictionary")
MsgBox "请输入数据"
'结束

'数据写入字典开始
Dim Myr&
Myr = 500 '需人工设定
For i = 1 To Myr
d(ExcelSheet.Application.Cells(i, 1).Value) = ExcelSheet.Application.Cells(i, 2).Value
Next
'结束

'将字典数据逐个写入到零件开始
Dim swApp As Object
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim myPath$, myFile$

Set swApp = _
Application.SldWorks
myPath = "C:\Users\Administrator\Desktop\1\" '..........................重点：把文件路径定义给变量
myFile = Dir(myPath & "*.sldprt") '依次找寻指定路径中的*.文件
Do While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 1, 0, "", longstatus, longwarnings)

    '单个零件写入数据开始
'Dim swApp As Object
Dim c As String
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
c = swApp.ActiveDoc.GetTitle() '零件名
blnretval = Part.AddCustomInfo3("", "数量", swCustomInfoText, d.Item(c))
    '单个零件写入数据结束

Part.Save
swApp.CloseDoc myPath & myFile
myFile = Dir '找寻下一个*.文件
Loop
'将字典数据逐个写入到零件结束
End Sub

谢谢鹿大的无私分享

非常需要、看下对否可以

谢谢分享

感谢楼主的分享

学习下代码，刚学习宏、、、

谢谢楼主，学习一下