本帖最后由 李邈 于 2024-9-7 09:41 编辑
sycfj 发表于 2024-9-7 09:27
能详细说明怎么使用吗？我在装配体中使用这个宏以后，工程图中不会出现数量
https://baijiahao.baidu.com/s?id=1796657905732909661&wfr=spider&for=pc
按照这个方法设置，他链接的是仓库 你连接数量那一栏就行了
设置好之后，把工程图文件另存为工程图模板，删掉上面的视图，下次新建就会直接出现
以前出的工程图，用批量替换模板的工具，全部替换成新的工程图模板就好啦
sycfj 发表于 2024-9-7 09:36
也就是说零件模板中要自定义属性 数量
这个宏会在每个零件体里添加了自定义属性数量这一栏，并且把数量填好了
你只要工程图去连接就行了
李邈 发表于 2024-9-7 09:25
装配体中使用
还是不会用，加个微sycfj2
Type BomPosition
model As SldWorks.ModelDoc2
Configuration As String
Quantity As Double
End Type
Const PRP_NAME As String = "数量"
Const MERGE_CONFIGURATIONS As Boolean = True
Const INCLUDE_BOM_EXCLUDED As Boolean = False
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
try_:
On Error GoTo catch_
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swApp.ActiveDoc
If swAssy Is Nothing Then
Err.Raise vbError, "", "Assembly is not opened"
End If
swAssy.ResolveAllLightWeightComponents True
Dim swConf As SldWorks.Configuration
Set swConf = swAssy.ConfigurationManager.ActiveConfiguration
Dim bom() As BomPosition
ComposeFlatBom swConf.GetRootComponent3(True), bom
If (Not bom) <> -1 Then
WriteBomQuantities bom
End If
GoTo finally_
catch_:
MsgBox Err.Description, vbCritical, "Count Components"
finally_:
End Sub
Sub ComposeFlatBom(swParentComp As SldWorks.Component2, bom() As BomPosition)
Dim vComps As Variant
vComps = swParentComp.GetChildren
If Not IsEmpty(vComps) Then
Dim i As Integer
For i = 0 To UBound(vComps)
Dim swComp As SldWorks.Component2
Set swComp = vComps(i)
If swComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed And (False = swComp.ExcludeFromBOM Or INCLUDE_BOM_EXCLUDED) Then
Dim swRefModel As SldWorks.ModelDoc2
Set swRefModel = swComp.GetModelDoc2()
If swRefModel Is Nothing Then
Err.Raise vbError, "", swComp.GetPathName() & " model is not loaded"
End If
Dim swRefConf As SldWorks.Configuration
Set swRefConf = swRefModel.GetConfigurationByName(swComp.ReferencedConfiguration)
Dim bomChildType As Integer
bomChildType = swRefConf.ChildComponentDisplayInBOM
If bomChildType <> swChildComponentInBOMOption_e.swChildComponent_Promote Then
Dim bomPos As Integer
bomPos = FindBomPosition(bom, swComp)
If bomPos = -1 Then
If (Not bom) = -1 Then
ReDim bom(0)
Else
ReDim Preserve bom(UBound(bom) + 1)
End If
bomPos = UBound(bom)
Dim refConfName As String
If MERGE_CONFIGURATIONS Then
refConfName = ""
Else
refConfName = swComp.ReferencedConfiguration
End If
Set bom(bomPos).model = swRefModel
bom(bomPos).Configuration = refConfName
bom(bomPos).Quantity = GetQuantity(swComp)
Else
bom(bomPos).Quantity = bom(bomPos).Quantity + GetQuantity(swComp)
End If
End If
If bomChildType <> swChildComponentInBOMOption_e.swChildComponent_Hide Then
ComposeFlatBom swComp, bom
End If
End If
Next
End If
End Sub
Function FindBomPosition(bom() As BomPosition, comp As SldWorks.Component2) As Integer
FindBomPosition = -1
Dim i As Integer
If (Not bom) <> -1 Then
Dim refConfName As String
If MERGE_CONFIGURATIONS Then
refConfName = ""
Else
refConfName = comp.ReferencedConfiguration
End If
For i = 0 To UBound(bom)
If LCase(bom(i).model.GetPathName()) = LCase(comp.GetPathName()) And LCase(bom(i).Configuration) = LCase(refConfName) Then
FindBomPosition = i
Exit Function
End If
Next
End If
End Function
Function GetQuantity(comp As SldWorks.Component2) As Double
On Error GoTo err_
Dim refModel As SldWorks.ModelDoc2
Set refModel = comp.GetModelDoc2
Dim qtyPrpName As String
qtyPrpName = GetPropertyValue(refModel, comp.ReferencedConfiguration, "UNIT_OF_MEASURE")
If qtyPrpName <> "" Then
GetQuantity = CDbl(GetPropertyValue(refModel, comp.ReferencedConfiguration, qtyPrpName))
Else
GetQuantity = 1
End If
Exit Function
err_:
Debug.Print "Failed to extract quantity of " & comp.Name2 & ": " & Err.Description
GetQuantity = 1
End Function
Function GetPropertyValue(model As SldWorks.ModelDoc2, conf As String, prpName As String) As String
Dim confSpecPrpMgr As SldWorks.CustomPropertyManager
Dim genPrpMgr As SldWorks.CustomPropertyManager
Set confSpecPrpMgr = model.Extension.CustomPropertyManager(conf)
Set genPrpMgr = model.Extension.CustomPropertyManager("")
Dim prpResVal As String
confSpecPrpMgr.Get3 prpName, False, "", prpResVal
If prpResVal = "" Then
genPrpMgr.Get3 prpName, False, "", prpResVal
End If
GetPropertyValue = prpResVal
End Function
Sub WriteBomQuantities(bom() As BomPosition)
Dim i As Integer
If (Not bom) <> -1 Then
For i = 0 To UBound(bom)
Dim refConfName As String
Dim swRefModel As SldWorks.ModelDoc2
Set swRefModel = bom(i).model
If MERGE_CONFIGURATIONS Then
refConfName = ""
Else
refConfName = bom(i).Configuration
If swRefModel.GetBendState() <> swSMBendState_e.swSMBendStateNone Then
Dim swConf As SldWorks.Configuration
Set swConf = swRefModel.GetConfigurationByName(refConfName)
Dim vChildConfs As Variant
vChildConfs = swConf.GetChildren()
If Not IsEmpty(vChildConfs) Then
Dim j As Integer
For j = 0 To UBound(vChildConfs)
Dim swChildConf As SldWorks.Configuration
Set swChildConf = vChildConfs(j)
If swChildConf.Type = swConfigurationType_e.swConfiguration_SheetMetal Then
SetQuantity swRefModel, swChildConf.Name, bom(i).Quantity
End If
Next
End If
End If
End If
SetQuantity swRefModel, refConfName, bom(i).Quantity
Next
End If
End Sub
Sub SetQuantity(model As SldWorks.ModelDoc2, confName As String, qty As Double)
Dim swCustPrpsMgr As SldWorks.CustomPropertyManager
Set swCustPrpsMgr = model.Extension.CustomPropertyManager(confName)
swCustPrpsMgr.Add3 PRP_NAME, swCustomInfoType_e.swCustomInfoText, qty, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue
swCustPrpsMgr.Set2 PRP_NAME, qty
End Sub
感谢楼主的分享 找了好久了
楼主，能求个宏吗？不会搞
看前方 发表于 2024-8-14 19:12
一直都是用凯元，自带了这个功能
在开元没有看到这个功能啊
sycfj 发表于 2024-9-7 09:36
也就是说零件模板中要自定义属性 数量
刷个威望下附件
李邈 发表于 2024-9-7 09:40
这个宏会在每个零件体里添加了自定义属性数量这一栏，并且把数量填好了
你只要工程图去连接就行了
刷个威望下附件
sycfj 发表于 2024-9-7 09:24
这个在工程图，装配体，零件哪个环境中使用
装配体环境中使用