I’m using this macro to edit my custom properties for older files. I’ve looked into task manager and want to use this if possible, but not sure how to edit my code so that it’ll open the file from a directory, run the macro, save and close.
Can anyone help me with adding to this macro? I’ve looked at a few blog posts and help files but I can’t get anything that I add in to work with this.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim vCustPropNames As Variant
Dim vCustPropTypes As Variant
Dim vCustPropVals As Variant
Dim colCurrent As New Collection
Dim colSkip As New Collection
Dim colMain As New Collection
Dim bSkip As Boolean
Dim bDefaultDataType As BooleanP
Sub Main()
Dim CustProp As CustProp
Dim curCustProp As CustProp
Dim i As Integer
'Clean up the collections.
Set colCurrent = Nothing
Set colSkip = Nothing
Set colMain = Nothing
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)
swCustPropMgr.Delete "REVISION"
If swModel Is Nothing Then Exit Sub 'Exit macro since no document is open.
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)
swCustPropMgr.GetAll vCustPropNames, vCustPropTypes, vCustPropVals
swCustPropMgr.Delete "REVISION"
MsgBox " Custom Property data updated."
If Not IsEmpty(vCustPropNames) Then
For i = 0 To UBound(vCustPropNames)
Set CustProp = New CustProp
CustProp.cpName = vCustPropNames(i)
CustProp.cpType = vCustPropTypes(i)
CustProp.cpValue = vCustPropVals(i)
colCurrent.Add CustProp
Next
End If
AddMainCustProps 'Add all "main" custom properties to collection colMain with method AddMainCustProps.
bDefaultDataType = False
Do While colCurrent.Count <> 0
For i = 1 To colMain.Count
Set CustProp = colMain.Item(i)
Set curCustProp = colCurrent.Item(1)
If CustProp.cpName = curCustProp.cpName Then
CustProp.cpValue = curCustProp.cpValue
If bDefaultDataType = False Then
CustProp.cpType = curCustProp.cpType
End If
colCurrent.Remove 1
bSkip = False
If colCurrent.Count = 0 Then Exit For
Else
bSkip = True 'bSkip = True If the custom property was NOT in the colMain collection.
End If
Next
If bSkip = True Then
colSkip.Add colCurrent.Item(1)
colCurrent.Remove 1
End If
Loop
If Not IsEmpty(vCustPropNames) Then
For i = 0 To UBound(vCustPropNames)
swCustPropMgr.Delete vCustPropNames(i)
Next i
End If
For Each CustProp In colMain
swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue
Next
For Each CustProp In colSkip
swCustPropMgr.Add2 CustProp.cpName, CustProp.cpType, CustProp.cpValue
Next
End Sub
Sub AddMainCustProps()
AddCustProp "ASSEMBLY", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "DESCRIPTION", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "PART NO.", swCustomInfoType_e.swCustomInfoText, "$PRP:""SW-File Name"""
AddCustProp "MATERIAL", swCustomInfoType_e.swCustomInfoText, """SW-Material@" & Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1) & """"
AddCustProp "COLOR", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "VENDOR", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "VENDOR PART NO.", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "WEIGHT", swCustomInfoType_e.swCustomInfoText, """SW-Mass@" & Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1) & """"
AddCustProp "REVISION", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "DRAWN", swCustomInfoType_e.swCustomInfoText, "GH"
AddCustProp "DRAWN DATE", swCustomInfoType_e.swCustomInfoText, "--/--/2018"
AddCustProp "UNIT", swCustomInfoType_e.swCustomInfoText, "EA"
AddCustProp "SOURCE", swCustomInfoType_e.swCustomInfoText, "M(MS),F(MJ),J(PJ),P(PS)"
AddCustProp "SORTCODE", swCustomInfoType_e.swCustomInfoText, "SPL001"
AddCustProp "ProdLine", swCustomInfoType_e.swCustomInfoText, "FC"
AddCustProp "ROUTER", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "COMMENT", swCustomInfoType_e.swCustomInfoText, ""
AddCustProp "TOLLERANCE", swCustomInfoType_e.swCustomInfoText, "0.060"
End Sub
Sub AddCustProp(cpName As String, cpType As Long, cpValue As Variant)
Dim CustProp As CustProp
Set CustProp = New CustProp
CustProp.cpName = cpName
CustProp.cpType = cpType
CustProp.cpValue = cpValue
colMain.Add CustProp
End Sub