|
|
经典案例图书 <div><div>Dim TopDocPathOnly As String
Dim PartsCollect() As String '遍历清单
Dim InCollectCount As Double '遍历清单长度
Dim CustomInfoQTY As String
Sub main()
Set swApp = Application.SldWorks '对象
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 = TopDocPathSplit(UBound(TopDocPathSplit) - 1) '总装目录名称
TopConfString = TopDoc.GetActiveConfiguration.Name '总装配置名称
CustomInfoQTY = InputBox("自定义属性名称", "遍历" & TopDocName, "数量") ' 可按个人喜好修改预设值
If CustomInfoQTY = "" Then Exit Sub '按下取消离开宏
InCollectCount = 1 '遍历清单长度基数
ReDim PartsCollect(InCollectCount) '定义阵列项数
SubAsm TopDoc, TopConfString '遍历
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 = ChildPathSplit(UBound(ChildPathSplit) - 1) '零件目录名称
If ChildPathOnly = TopDocPathOnly Then SamePath = True Else SamePath = False '是否在总装目录
If SamePath And (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(ChildConfString, CustomInfoQTY) + 1 * UNIT_OF_MEASURE
ChildModel.DeleteCustomInfo2 ChildConfString, CustomInfoQTY
ChildModel.AddCustomInfo3 ChildConfString, CustomInfoQTY, 30, ht_Qty
Else '不在遍历清单内（首次处理）
ChildModel.DeleteCustomInfo2 ChildConfString, CustomInfoQTY
ChildModel.AddCustomInfo3 ChildConfString, CustomInfoQTY, 30, UNIT_OF_MEASURE
InCollectCount = InCollectCount + 1
ReDim Preserve PartsCollect(InCollectCount) '重新定义数组项数（保留内含数据）
PartsCollect(InCollectCount - 1) = ChildConfString & "@" & ChildName '加入到遍历清单中
ChildModel.SetUserPreferenceIntegerValue swUnitsMassPropMass, swUnitsMassPropMass_Kilograms '单位设定为kg（可按喜好加入设定）
End If
End If
If ChildType = 2 Then
SubAsm ChildModel, ChildConfString '如果是装配则向下遍历
End If
End If
Next
End Function</div><div></div><div></div><div>新建个宏，这个是在其他网站转后修改的，可以对子装配相同零件单台用的统计，数量写入特定配置进，自定义属性是：数量。
</div></div>
复制代码 |
|
发表于 2017-2-24 16:54:17
许久没发过工具了～ 发一个吧～功能：自动计算一个组件中，零件的个数。
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
为什么2014不能用呢
鲁公网安备 37028502190335号