Good Afternoon All,

Being a complete API novice I have been looking for a macro that will go through an assembly and change specific custom properties for the sub assemblies and haven't managed to find anything at all that is related.  I have however managed to put something together based on several different things that i have found which isn't completely air tight however it seems to run ok even if some times it does delete the variables ad not create them if the instances are met initially.  Haven't been able to figure out how to achieve this.

The thing however that i am struggling with it is to change custom properties on referenced drawings that are for either the top level assembly or any of the drawings for the parts that are in the assembly.

The current code is as follows:

Option Explicit

Dim swApp As SldWorks.SldWorks

Sub main()

Dim swModel As ModelDoc2

Dim vComps As Variant

Dim swComp As SldWorks.Component2

Dim swAssy As SldWorks.AssemblyDoc

Dim i As Integer

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

Dim strDesToReplace As String

Dim strDesReplacing As String

Dim strNoToReplace As String

Dim strNoReplacing As String

strDesToReplace = InputBox("Please enter the text that you wish to find within the Description Custom Property", "Enter Search String")

strDesReplacing = InputBox("Please enter the text that you wish to replace the previously entered string in the Description Custom Property", "Enter Replacing String")

strNoToReplace = InputBox("Please enter the text that you wish to find within the Part Number Custom Property", "Enter Search String")

strNoReplacing = InputBox("Please enter the text that you wish to replace the previously entered string in the Part Number Custom Property", "Enter Replacing String")

If strDesToReplace = "" Or strDesReplacing = "" Or strNoToReplace = "" Or strNoReplacing = "" Then

    Exit Sub

Else

    ChangeValues swModel, strDesToReplace, strDesReplacing, strNoToReplace, strNoReplacing

    If swModel.GetType = swDocASSEMBLY Then

        Set swAssy = swModel

        vComps = swAssy.GetComponents(False)

        For i = 0 To UBound(vComps)

            Set swComp = vComps(i)

            Set swModel = swComp.GetModelDoc2

            'updateProperty swModel

            ChangeValues swModel, strDesToReplace, strDesReplacing, strNoToReplace, strNoReplacing

        Next i

    End If

    MsgBox "All Custom Properties have been successfully changed", vbInformation + vbOK, "Find & Replace Complete"

End If

End Sub

Function ChangeValues(swModel As SldWorks.ModelDoc2, strDesToReplace As String, strDesReplaceWith As String, strNoToReplace As String, strNoReplaceWith As String) As Boolean

Dim cpm As CustomPropertyManager

Dim names As Variant

Dim name As Variant

Dim textexp As String

Dim evalval As String

Dim strNumber As String

Dim strDescription As String

Dim strdrw_no As String

Set cpm = swModel.Extension.CustomPropertyManager("")

names = cpm.GetNames

For Each name In names

    cpm.Get2 name, textexp, evalval

    Debug.Print name & " = " & evalval

    If name = "Description" Then

        If evalval <> "" Then

            strDescription = Replace(evalval, strDesToReplace, strDesReplaceWith)

            cpm.Delete "Description"

            cpm.Add2 "Description", swCustomInfoText, strDescription

        End If

    End If

Next name

For Each name In names

    cpm.Get2 name, textexp, evalval

    Debug.Print name & " = " & evalval

    If name = "Number" Then

        If evalval <> "" Then

            strNumber = Replace(evalval, strNoToReplace, strNoReplaceWith)

            cpm.Delete "Number"

            cpm.Add2 "Number", swCustomInfoText, strNumber

        End If

    End If

Next name

For Each name In names

    cpm.Get2 name, textexp, evalval

    Debug.Print name & " = " & evalval

    If name = "drw_no" Then

        If evalval <> "" Then

            strdrw_no = Replace(evalval, strNoToReplace, strNoReplaceWith)

            cpm.Delete "drw_no"

            cpm.Add2 "drw_no", swCustomInfoText, strdrw_no

        End If

    End If

Next name

End Function

Can anyone please assist me with this.

Thanks in advanced

Frosty