装配体属性零件数量遍历和批量修改零件属性

xiaoxifeng

装配体属性零件数量遍历和批量修改零件属性能否合并呢？就是在打开装配体的时候自动遍历装配体下面所有的零件的数量和属性。谁能给合并下啊

Dassault

论坛中已经包含了渔具和鱼饵了。

xiaoxifeng

可是我不会弄啊。有人出来帮忙吗？

xieguiming113

Dim TopDocPathOnly     As String
Dim PartsCollect()     As String '遍历清单（阵列）
Dim InCollectCount     As Double '遍历清单长度
Dim CustomInfoQTY      As String
Dim S1                 As Integer
Dim S2                 As Integer
Dim Path_Name          As String
Dim Code_Name_C        As String
Dim Code_              As String
Dim Name_              As String
Dim swApp              As SldWorks.SldWorks
Dim swModelDoc         As SldWorks.ModelDoc2
Dim swConfig           As SldWorks.Configuration
Dim CustPropMgr        As SldWorks.CustomPropertyManager

Sub main096()
Set swApp = Application.SldWorks 'SW对象
Set TopDoc = swApp.ActiveDoc '总装对象
If TopDoc.GetType <> 2 Then Exit Sub '不是装配=退出
TopDocPathSplit = Split(TopDoc.GetPathName, "\") '分割
TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '总装文件名称
TopDocName = Left(TopDocName, Len(TopDocName) - 7) '总装文件名称（排除.SLDASM）
TopDocPathOnly = Mid(TopDoc.GetPathName, 1, InStrRev(TopDoc.GetPathName, "\", -1)) '总装的完整目录
TopConfString = TopDoc.GetActiveConfiguration.name '總裝配置名稱

CustomInfoQTY = "加工数量" '可按个人喜好修改预设值

InCollectCount = 1 '遍历清单长度基数
ReDim PartsCollect(InCollectCount) '定义阵列项数

TopCode_ = Left(TopDocName, InStr(TopDocName, " ") - 1)
TopName_ = Right(TopDocName, Len(TopDocName) - InStr(TopDocName, " "))

'Set TopCustPropMgr = TopDoc.Extension.CustomPropertyManager(TopConfString) '如要添加到配置中请启用本代码
Set TopCustPropMgr = TopDoc.Extension.CustomPropertyManager(ConfName) '写入自定义


TopCustPropMgr.Add2 "材料", 30, Chr(34) & "SW-Material@*" & TopDocName & ".SLDASM""" '在自订属性加入属性

TopCustPropMgr.Add2 "重量", 30, Chr(34) & "SW-Mass@*" & TopDocName & ".SLDASM""" '在自订属性加入属性

TopCustPropMgr.Add2 "体积", 30, Chr(34) & "SW-Volume@*" & TopDocName & ".SLDASM"""  '在自订属性加入属性

TopCustPropMgr.Add2 "表面积", 30, Chr(34) & "SW-SurfaceArea@*" & TopDocName & ".SLDASM""" '在自订属性加入属性

TopCustPropMgr.Add2 "公司名称", 30, "浩气航空地面设备"

TopCustPropMgr.Add2 "设计者", 30, "谢贵明"

TopCustPropMgr.Add2 "备注说明", 30, " "

TopCustPropMgr.Add2 "表面处理", 30, " "

TopCustPropMgr.Add2 "工艺类型", 30, " "


TopCustPropMgr.Delete ("图号") '删除栏
TopCustPropMgr.Delete ("名称")


TopCustPropMgr.Add2 "图号", swCustomInfoText, TopCode_ '新增
TopCustPropMgr.Add2 "名称", swCustomInfoText, TopName_


SubAsm TopDoc, TopConfString '遍历

Set swApo = Application.SldWorks '重建模型
Set Part = swApo.ActiveDoc
Part.EditRebuild

Set swModel = swApo.ActiveDoc '保存当前文件
swModel.Save
Set swApo = _
Application.SldWorks

Beep '嘟的提示音

End Sub

Function SubAsm(AsmDoc, ConfString) '统计装配体各零件数量
Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
Set RootComponent = Configuration.GetRootComponent
Components = RootComponent.GetChildren
For Each Child In Components
Set ChildModel = Child.GetModelDoc
If Not (ChildModel Is Nothing) Then '排除抑制及轻化
ChildConfString = Child.ReferencedConfiguration '零件配置名称
ChildType = ChildModel.GetType
ChildPathSplit = Split(Child.GetPathName, "\") '分割
ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名称
ChildPathOnly = Mid(Child.GetPathName, 1, InStrRev(Child.GetPathName, "\", -1)) '零件的完整目录
If ChildPathOnly = Replace(ChildPathOnly, TopDocPathOnly, "") Then SamePath = False Else SamePath = True '零件是否在总装目录或往下目录
If SamePath And (Not Child.ExcludeFromBOM) And (Not Child.IsEnvelope) Then '跳過：不在总装目錄或其往下目錄 或 不包括在材料明細表中 或 是个封套
If (Not Child.ExcludeFromBOM) And (Not Child.IsEnvelope) Then '跳过：不包括在材料明細表中 及 封套
UNIT_OF_MEASURE_Name = ChildModel.CustomInfo2(ChildConfString, "UNIT_OF_MEASURE") '备用量属性名称
UNIT_OF_MEASURE = ChildModel.CustomInfo2(ChildConfString, UNIT_OF_MEASURE_Name) '备用量
If (UNIT_OF_MEASURE = 0) Or (UNIT_OF_MEASURE = "") Then UNIT_OF_MEASURE = 1 '备用量除错
inCollect = False '重置判断变量
For Each PartinCollect In PartsCollect '判断是否已在遍历清单內
If ChildConfString & "@" & ChildName = PartinCollect Then inCollect = True
Next
If inCollect Then '已在遍历清单內
ht_Qty = ChildModel.CustomInfo2("", CustomInfoQTY) + 1 * UNIT_OF_MEASURE
ChildModel.DeleteCustomInfo2 "", CustomInfoQTY
ChildModel.AddCustomInfo3 "", CustomInfoQTY, 30, ht_Qty
Else '不在遍历清单內（首次处理）
ChildModel.DeleteCustomInfo2 "", CustomInfoQTY
ChildModel.AddCustomInfo3 "", CustomInfoQTY, 30, UNIT_OF_MEASURE
InCollectCount = InCollectCount + 1 '遍历清单长度基数+1
ReDim Preserve PartsCollect(InCollectCount) '重新定义阵列项数（保留內含数据）
PartsCollect(InCollectCount - 1) = ChildConfString & "@" & ChildName '加入到遍历清单中
ChildModel.SetUserPreferenceIntegerValue swUnitSystem, swUnitSystem_Custom '单位系统=Custom
ChildModel.SetUserPreferenceIntegerValue swUnitsMassPropMass, swUnitsMassPropMass_Kilograms '重量单位设定为kg（可按喜好加入設定）
ChildModel.SetUserPreferenceIntegerValue swUnitsMassPropLength, swMM '设定长度单位为毫米
ChildModel.SetUserPreferenceIntegerValue swUnitsMassPropVolume, swUnitsMassPropVolume_Centimeters3 '设定体积单位为立方厘米
ChildModel.SetUserPreferenceIntegerValue swUnitsMassPropDecimalPlaces, 2 '质量及体积小数点后2位

ChildModel.AddCustomInfo3 "", "材料", 30, Chr(34) & "SW-Material@*" & ChildName & Chr(34) '在自订属性加入属性

ChildModel.AddCustomInfo3 "", "重量", 30, Chr(34) & "SW-Mass@*" & ChildName & Chr(34) '在自订属性加入属性

ChildModel.AddCustomInfo3 "", "体积", 30, Chr(34) & "SW-Volume@*" & ChildName & Chr(34) '在自订属性加入属性

ChildModel.AddCustomInfo3 "", "表面积", 30, Chr(34) & "SW-SurfaceArea@*" & ChildName & Chr(34) '在自订属性加入属性

ChildModel.AddCustomInfo3 "", "公司名称", 30, "上海浩气机械设备有限公司"

ChildModel.AddCustomInfo3 "", "设计者", 30, "谢贵明"

ChildModel.AddCustomInfo3 "", "备注说明", 30, " "

ChildModel.AddCustomInfo3 "", "表面处理", 30, " "

ChildModel.AddCustomInfo3 "", "工艺类型", 30, " "

'ChildModel.AddCustomInfo3 ChildConfString, "Weight", 30, Chr(34) & "SW-Mass@@" & ChildConfString & "@*" & ChildName & Chr(34) '如要添加到配置中请启用本代码
'ChildModel.AddCustomInfo3 ChildConfString, "Material", 30, Chr(34) & "SW-Material@@" & ChildConfString & "@*" & ChildName & Chr(34) '如要添加到配置中请启用本代码

'ConfName = ChildModel.GetActiveConfiguration.Name '如要添加到配置中请启用本代码
Set CustPropMgr = ChildModel.Extension.CustomPropertyManager(ConfName)

Path_Name = ChildModel.GetPathName() '取得"路径名称及扩展名",不管扩展名是否应藏
S1 = InStrRev(Path_Name, "\") '\符号在路径之最后位置数
Code_Name_C = Right(Path_Name, Len(Path_Name) - S1) '取得件号_名称.扩展名"
S2 = InStr(Code_Name_C, " ") '_符号在"件号_名称.扩展名"之位数
Code_ = Left(Code_Name_C, S2 - 1) '取得"件号"
Name_ = Mid(Code_Name_C, S2 + 1, Len(Code_Name_C) - S2 - 7) '取得"件号_名称"


CustPropMgr.Delete ("图号") '删除栏
CustPropMgr.Delete ("名称")


CustPropMgr.Add2 "图号", swCustomInfoText, Code_ '新增
CustPropMgr.Add2 "名称", swCustomInfoText, Name_


ChildModel.SketchManager.Insert3DSketch True '插入三低草图，从而激活零件的“需存盘标签”
ChildModel.SketchManager.Insert3DSketch True '离开三低草图

End If
If ChildType = 2 Then
SubAsm ChildModel, ChildConfString '如果是装配则向下遍历
End If
End If
End If
End If
Next
End Function

xiaoxifeng

这个可以在exel表中运行吗？好像这是个sw的宏吧

xieguiming113

xiaoxifeng 發表於 2016/11/24 16:12
这个可以在exel表中运行吗？好像这是个sw的宏吧

是的

Dassault

假設流程如下可否接受：
1. 在SW手動打開總組合件
2. 運行特定的巨集（宏）
3. 巨集自動打開指定Excel文檔匯入總組合件內所有次組件及零件的屬性
4. 在Excel內按照自己的意願手動修改屬性
5. 點選Excel內的特定巨集，巨集會自動將表格內的屬性寫進次組件及零件
6. 回到SW可發現所有的屬性已經更新，保存一下即可

xiaoxifeng

楼上的，这个流程也很好啊。不知道能否贴出你的代码呢？就是不知道导入EXCEL文件后。零件的路径。能不能也跟着出现呢？不过我还是想问下。就是在EXC里能不能打开一个装配体。然后他就会遍历出所有的零件及属性呢啊？