ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
RCRobert Caste09/08/2018

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