Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim swApp As SldWorks.SldWorks

Dim swSheetMetal As ISheetMetalFeatureData

Dim sDirectory      As String

Dim Response        As String

Dim swDocType       As String

Dim longstatus      As Long

Dim longwarnings    As Long

Dim swModel As SldWorks.ModelDoc2

Sub main()

​

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    If Not swModel Is Nothing Then

        Dim swFileName As String

        ' Get the File Name

        swFileName = swModel.GetTitle

        Dim sPartNo As String

        Dim vDescription As String

        Dim sDescription() As String

        Dim sFinish As String

        Dim sECN As String

        Dim i As Integer

        Dim delimiter As String

        ' Request ECN, assuming part numbers have just been assigned and a project released

        sECN = InputBox("Please Enter the ECN for this Project Release")

        swDocType = ".SLDPRT"

        Response = Dir("")

        Do Until Response = ""

            If Right(UCase$(Response), 7) = swDocType Then

                Set swModel = swApp.OpenDoc6(Response, 1, 0, "", longstatus, longwarnings)

                Set swModel = swApp.ActiveDoc

                swFileName = swModel.GetTitle

                ' MsgBox "Current File (Response) = " & Response & vbNewLine & "ECN is: " & sECN

                ' MsgBox "Inserting ECN: " & sECN

                ' MsgBox "Current File to update: " & swFileName

                ' PartNo

                sPartNo = Split(swFileName, " ")(0)

                ' Description

                delimiter = "_"

                sDescription() = Split(Replace(swFileName, " ", delimiter, 1, 1), delimiter)

                    ' MsgBox "Description Split 1 is: " & sDescription(1)

                vDescription = Split(sDescription(1), ".")(0)

                    ' MsgBox "Description Split 2 is: " & vDescription

                ' Finish

                sFinish = Right(Split(swFileName, " ")(0), 2)

                Set swCustPropMgr = swModel.Extension.CustomPropertyManager(Empty)

​

                ' Input data in to custom properties

                swCustPropMgr.Add3 "PartNo", swCustomInfoText, sPartNo, 0

                swCustPropMgr.Add3 "Description", swCustomInfoText, vDescription, 0

                swCustPropMgr.Add3 "Finish", swCustomInfoText, sFinish, 0

                swCustPropMgr.Add3 "Author", swCustomInfoText, "MA", 0

                swCustPropMgr.Add3 "ECN", swCustomInfoText, sECN, 0

                swCustPropMgr.Add3 "PartNo", swCustomInfoText, sPartNo, 2

                swCustPropMgr.Add3 "Description", swCustomInfoText, vDescription, 2

                swCustPropMgr.Add3 "Finish", swCustomInfoText, sFinish, 2

                swCustPropMgr.Add3 "Author", swCustomInfoText, "MA", 2

                swCustPropMgr.Add3 "ECN", swCustomInfoText, sECN, 2

                swModel.Save2 (Silent)

                swApp.CloseDoc (Response)

            End If

            Response = Dir()

            Loop

        MsgBox "Done!"

        Else

        MsgBox "Please open part or assembly"

        End If

End Sub

​

​

​

​