Hello,

I have a code, which I am trying to modify using two working codes and combine them into one. IN the end, it should: Use specific property called Kiekis from every Part (it is quantity used in assembly), and multiply with the every cutlist item in a weldment or multibody part under parameter QTY_Total. Code works when run in the part, but not form the assembly.

So far I get an error in swPart = swApp.ActiveDoc.
It is probably when macro tries to run the assembly (which is not a part). Maybe someone knows how to resolve this? Code bellow:

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim vComps As Variant
Dim swComp As SldWorks.Component2
Dim swAssy As SldWorks.AssemblyDoc
Dim i As Integer
Dim wo_num As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

'On Error Resume Next

'wo_num = "\$PRP:" + Chr(34) + "SW-BOM Part Number" + Chr(34)
updateProperty swModel, wo_num
 
If swModel.GetType = swDocASSEMBLY Then
Set swAssy = swModel
vComps = swAssy.GetComponents(False)
For i = 0 To UBound(vComps)
Set swComp = vComps(i)
If swComp.GetSuppression = swComponentFullyResolved Then
Set swModel = swComp.GetModelDoc2
updateProperty swModel, wo_num
 
End If
 
Next i
End If

MsgBox "Macro Done"

'Debug.Print "mvalue"; wo_num

End Sub
 
Function updateProperty(swModel As SldWorks.ModelDoc2, mValue As String) As Boolean

'On Error Resume Next

'Dim swApp As SldWorks.SldWorks
'Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swPart As SldWorks.PartDoc
Dim config1 As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim ValOut_Kiekis As String
Dim Resolved_Kiekis As String
Dim wasResolved1 As Boolean
Dim LRET_KIEK As String
Dim ValueQTY As String
Dim ValueResolvedQTY As String
Dim res As Long
Dim CutListQty As String
Dim TotQ As String
Dim bRet As Boolean

 
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature
Set swCustPropMgr = swFeat.CustomPropertyManager
Set swPart = swApp.ActiveDoc
Set config1 = swPart.GetActiveConfiguration
Set cusPropMgr = config1.CustomPropertyManager
 
'Config Prop

LRET_KIEK = cusPropMgr.Get5("Kiekis", True, ValOut_Kiekis, Resolved_Kiekis, wasResolved1)
Debug.Print Resolved_Kiekis ' Kiekis config

'Config Prop

res = swCustPropMgr.Get4("Quantity", True, ValueQTY, ValueResolvedQTY)
Debug.Print ValueQTY; ValueResolvedQTY; " Done"

Do While Not swFeat Is Nothing

If swFeat.GetTypeName = "CutListFolder" Then
 
CutListQty = swFeat.GetSpecificFeature2.GetBodyCount
 
TotQ = CutListQty * Resolved_Kiekis
 
bRet = swFeat.CustomPropertyManager.Add3("TOTAL_QTY", swCustomInfoType_e.swCustomInfoNumber, TotQ, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Debug.Print TotQ
 
End If

Set swFeat = swFeat.GetNextFeature

Loop 'Loop through the part looking for cutlist items

End Function


​​​​​​​