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
SolidworksApi macros