5 Replies Latest reply on Apr 30, 2018 3:41 PM by Craig Makarowski

    Set swCustProp = swModel.Extension.CustomPropertyManager("") error

    Craig Makarowski

      I wrote this macro to copy custom properties to the summary page it worked before but now has this error I'm using SW2016 SP5 currently and will be moving to SW2017 soon. Any help or suggestion would be greatly welcome thank you.

      here is the source code for the macro:

       

      Dim swApp As Object

      Sub main()

          Dim swApp             As SldWorks.SldWorks

          Dim swModel          As SldWorks.ModelDoc2

          Dim swCustProp     As CustomPropertyManager

          Dim val                   As String

          Dim valout              As String

          Dim bool                As Boolean

       

       

       

          Set swApp = CreateObject("SldWorks.Application")

          Set swModel = swApp.ActiveDoc

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

            

          bool = swCustProp.Get4("PART_NAME", False, val, valout)

          swModel.SummaryInfo(swSumInfoTitle) = valout

          bool = swCustProp.Get4("DRAWN_BY", False, val, valout)

          swModel.SummaryInfo(swSumInfoAuthor) = valout

          bool = swCustProp.Get4("Part_Type", False, val, valout)

          swModel.SummaryInfo(swSumInfoKeywords) = valout

         

          'swModel.SummaryInfo(swSumInfoComment) = valout

         

          'swModel.SummaryInfo(swSumInfoSubject) = valout

          swModel.ForceRebuild3 (False)

          swModel.Save

       

       

       

      End Sub

        • Re: Set swCustProp = swModel.Extension.CustomPropertyManager("") error
          Peter Kennedy

          I didn't test this but try:

           

          Set swApp = Application.Sldworks

           

          Cause that's the only thing I can see different from here: 2017 SOLIDWORKS API Help - Get Custom Properties of Referenced Part Example (VBA)

           

          Try this:

           

          Dim swApp As Object

          Sub main()

              Dim swApp             As SldWorks.SldWorks

              Dim swModel          As SldWorks.ModelDoc2

              Dim swModelDocExt     As ModelDocExtension

              Dim swCustProp     As CustomPropertyManager

              Dim val                   As String

              Dim valout              As String

              Dim bool                As Boolean

           

           

           

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

               Set swModelDocExt = swModel.Extension

              Set swCustProp = swModelDocExt.CustomPropertyManager("")

              

              bool = swCustProp.Get4("PART_NAME", False, val, valout)

              swModel.SummaryInfo(swSumInfoTitle) = valout

              bool = swCustProp.Get4("DRAWN_BY", False, val, valout)

              swModel.SummaryInfo(swSumInfoAuthor) = valout

              bool = swCustProp.Get4("Part_Type", False, val, valout)

              swModel.SummaryInfo(swSumInfoKeywords) = valout

           

              'swModel.SummaryInfo(swSumInfoComment) = valout

           

              'swModel.SummaryInfo(swSumInfoSubject) = valout

              swModel.ForceRebuild3 (False)

              swModel.Save

           

           

           

          End Sub

          • Re: Set swCustProp = swModel.Extension.CustomPropertyManager("") error
            Rob Edwards

            Hi Craig

            Your macro works fine for me...

            the only time I recreate your error is when there is no active document

              • Re: Set swCustProp = swModel.Extension.CustomPropertyManager("") error
                Amen Allah Jlili

                That's it. He should make sure that there is an active document to begin with.

                 

                Set swModel = swApp.ActiveDoc
                'Check if there is an active document. If no, exits the macro. 
                If swModel Is Nothing Then
                swApp.SendMsgToUser "There is no active document"
                Exit Sub
                End if
                

                Cheers,
                Amen
                www.cadsharp.com

                  • Re: Set swCustProp = swModel.Extension.CustomPropertyManager("") error
                    Craig Makarowski

                    Thank you I have it working now

                    here is the code

                    Sub main()

                        Dim swApp          As SldWorks.SldWorks

                        Dim swModel        As SldWorks.ModelDoc2

                        Dim swCustProp     As CustomPropertyManager

                        Dim val            As String

                        Dim valout         As String

                        Dim bool           As Boolean

                        Dim tempval        As String

                     

                        Set swApp = Application.SldWorks

                        'Set swApp = CreateObject("SldWorks.Application")

                        Set swModel = swApp.ActiveDoc

                        'Check if there is an active document. If no, exits the macro.

                        If swModel Is Nothing Then

                        swApp.SendMsgToUser "There is no active document"

                        Exit Sub

                        End If

                       

                       

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

                          

                        bool = swCustProp.Get4("PART_NAME", False, val, valout)

                        swModel.SummaryInfo(swSumInfoTitle) = valout

                        bool = swCustProp.Get4("DRAWN_BY", False, val, valout)

                        swModel.SummaryInfo(swSumInfoAuthor) = valout

                        bool = swCustProp.Get4("Part_Type", False, val, valout)

                        tempval = valout

                        bool = swCustProp.Get4("category", False, val, valout)

                        swModel.SummaryInfo(swSumInfoKeywords) = valout + "," + tempval

                        swModel.SummaryInfo(swSumInfoSubject) = valout

                        bool = swCustProp.Get4("Description", False, val, valout)

                        swModel.SummaryInfo(swSumInfoComment) = valout

                       

                        swModel.ForceRebuild3 (False)

                        swModel.Save

                        swApp.SendMsgToUser "Parameters Written"

                     

                     

                    End Sub