CAD Forum

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

If swModel.GetType = swDocASSEMBLY Then

wo_num = InputBox("Enter Property Value")
updateProperty swModel, wo_num

Set swAssy = swModel
swAssy.ResolveAllLightWeightComponents False
vComps = swAssy.GetComponents(False)
For i = 0 To UBound(vComps)
Set swComp = vComps(i)
If Not swComp.GetSuppression2 = 0 Then
Set swModel = swComp.GetModelDoc2
updateProperty swModel, wo_num
End If
Next i

Else
MsgBox "Active document is not an assembly, exiting"
End
End If

End Sub

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

Dim cpm As CustomPropertyManager
Set cpm = swModel.Extension.CustomPropertyManager("")
cpm.Add3 "Number", swCustomInfoText, mValue, 1

End Function

Bradfordzzz wrote: ↑Sat Mar 18, 2023 8:59 am Works fine with one very minor change.

Change this .... If Not swComp .GetSuppression2 = 0 Then
to this ..... If Not swComp.GetSuppression2 = 0 Then

There is a space there that needs to be removed.

gupta9665 wrote: ↑Sat Mar 18, 2023 8:15 am Try following codes (not tested but should work)

Ömür Tokman wrote: ↑Mon Mar 20, 2023 6:19 am Hi Gupta,
This macro caught my attention, but I couldn't quite understand what it would do exactly, I tried it in a simple assembly, it added a number to the special properties of all parts (which I wrote).

gupta9665 wrote: ↑Mon Mar 20, 2023 12:34 pm This macro add a property named "Number" (you can change the property name) in all the components of the assembly and property value will be the one which a user fills in the input box. The value would be same for all the components.

TTevolve wrote: ↑Tue Mar 21, 2023 8:56 am Thanks Deepak for the macro. It gets me most of the way there.

I think you misunderstood what I want to do though. The assembly is 1234, the first part in the assembly is 1234-A, the second part is 1234-B, third part is 1234-C and so on. When I run the macro it changes the prefix in the parts, but drops the -A, -B, -C, ect. at the end of each part number. Is it possible to leave the suffix for each part?

The on you created is really helpfully for changing the creation date field in the custom properties though :-)

TTevolve wrote: ↑Thu Mar 23, 2023 9:11 am I am goign to have to brush up on my coding skills some. I get the logic, just don't know the syntax of the coding.

bneff wrote: ↑Fri Aug 25, 2023 10:08 am I just ran across this post and the original code to add a custom property "number" is just what I was looking for. But I would like to have it prompt for two different numbers to add.

bneff wrote: ↑Wed Apr 17, 2024 1:54 pm Thanks for the update Deepak. I noticed that this only adds the custom property to the components of the top assembly. Any thoughts on how to add also to the components of sub-assemblies in the top assembly?

sooz wrote: ↑Tue Jul 16, 2024 5:19 pm Is there a version of this that I can apply specific text to all cutlist items in a part file? This seems geared towards assembly files only. Thanks Deepak!

gupta9665 wrote: ↑Wed Jul 17, 2024 1:55 am You can check the codes from the cut list related macros here https://www.codestack.net/solidworks-tools/#cut-list by @Artem

Option Explicit
Sub Main()
    Dim SwApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    Dim swSubFeat As SldWorks.Feature
    
    Set SwApp = Application.SldWorks
    Set swModel = SwApp.ActiveDoc
    If swModel Is Nothing Then MsgBox ("Open a part"): Exit Sub
    If swModel.GetType <> swDocumentTypes_e.swDocPART Then MsgBox ("Open a part"): Exit Sub

    Set swFeat = swModel.FirstFeature
    While Not swFeat Is Nothing
        Set swSubFeat = swFeat.GetFirstSubFeature
        While Not swSubFeat Is Nothing
            SetCustomPropFromFolderName swSubFeat
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Wend
        Set swFeat = swFeat.GetNextFeature
    Wend
End Sub

Sub SetCustomPropFromFolderName(swFeat As SldWorks.Feature)
    Dim swCutFolder As SldWorks.BodyFolder
    Dim cpm As SldWorks.CustomPropertyManager
    If swFeat.GetTypeName2 <> "CutListFolder" Then Exit Sub
    Set swCutFolder = swFeat.GetSpecificFeature2
    If swCutFolder Is Nothing Then Exit Sub
    If swCutFolder.GetBodyCount = 0 Then Exit Sub
    Set cpm = swFeat.CustomPropertyManager
    If cpm Is Nothing Then Exit Sub
    cpm.Add3 "CL PART NO", swCustomInfoType_e.swCustomInfoText, swFeat.Name, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue
End Sub