Macro to change custom properties

[TTevolve]

I was wondering if anyone has a macro that will change custom properties? I do a bunch of projects where I do a pack-and-go to re-number the part files. For example I might have a assembly with the name A1234 and all the parts and sub assemblies are A1234-A, A1234-B, A1234-C and so on. In the custom properties field which is would be usually be the same, or some variation of it (like A1234-A-W for a weldment part). Is it possible to have a macro run on an assembly and change all of the A1234 to B4321 on the main assembly and all the sub parts?

For instance this part is EVxxxx-MD01-F, the number field is the same.

This is a part in my base assembly EVxxxx-MD01, I will do a pack-and-go and renanme the assembly to EV1458-MD01 and the part will become EV1458-MD01-F. I would like to run the macro on the new assembly and change all the EVxxxx out on all custom properties to now be EV1458. Has anyone done something like this? And is it even possible to change custom properties on parts in an assembly when running the macro on the assembly level?

[gupta9665]

Try following codes (not tested but should work)

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]

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]

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.

Thanks, fixed that.

[Ömür Tokman]

Try following codes (not tested but should work)

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]

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).

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.

[Ömür Tokman]

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.

Yes now I get it, frankly I misunderstood the point, I thought you were renaming all the parts in an assembly with a sequential dash. So after running the macro I thought you could change the part names like P1,P2,...etc, that would be great.
Thank you very much for the explanation.

[TTevolve]

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 :-)

[gupta9665]

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 :-)

Yes this can be done as well. Will make the changes and add later.

[gupta9665]

Try these codes (not much error handling is added). Also does not handle to skip component already updated.

You need to enter the existing property value followed by a - and then desired new property. For e.g. A1234-X1234

Code: Select all

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 Orignal Property Value - Required Property Value, e.g. 123-XYZ")
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("")

Dim sValue() As String
sValue = Split(mValue, "-", 2)

Dim prpVal(1) As String
cpm.Get3 "Number", False, prpVal(0), prpVal(1)

If Not prpVal(1) = "" Then
  cpm.Add3 "Number", swCustomInfoText, Replace(prpVal(1), sValue(0), sValue(1)), 1
End If

End Function

[TTevolve]

Thanks Deepak, it worked as I wanted it to. 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.

[gupta9665]

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.

Check the API learning resources here https://tinyurl.com/DeepakGuptaAPI

[bneff]

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.

[gupta9665]

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.

Sorry, missed your post and just found it today only.

There are 2 ways:

1. You can add the number in the same separated by a comma, dash or something similar. And then macro can split the entered data into 2 numbers and add the desired value as needed.

2. Just add the same line of the code with variable name and you will get 2 prompts.

[bneff]

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]

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]

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?

Sorry for a late response (have missed your reply). The codes works for all components in the assembly. Can you please verify again?

[gupta9665]

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!

You can check the codes from the cut list related macros here https://www.codestack.net/solidworks-tools/#cut-list by @Artem

[sooz]

You can check the codes from the cut list related macros here https://www.codestack.net/solidworks-tools/#cut-list by @Artem

I'm currently using their rename features, but i want to utilize this code below to add in my own custom text everytime to a custom property. At the moment, this code below copies the cutlist folder name and adds it to a cutlist property "CL PART NO". this is fine but its not connected, it's just plain text.

I would like it to allow me to input specific text to this cutlist property: "SW-CutListItemName"

Code: Select all

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