11 Replies Latest reply on Feb 21, 2014 10:19 AM by Kevin Tate

    Copy summary property to custom property

    Kevin Tate

      Hello,

       

      I've been trying to figure this out myself for a while now but I'm getting no where fast. I am trying to copy the information contained within the summary properties fields in a model to a specific custom property using a macro. I need to do this as I am trying to update a lot of old models.

       

      I have hashed together code I have found o nthe internet and come up with the following:

      -----------------------------------------------------------------

      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

          Dim swSumInfoTitle      As Integer

       

       

          Set swApp = CreateObject("SldWorks.Application")

       

          Set swModel = swApp.ActiveDoc

       

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

       

       

          valout = instance.SummaryInfo(swSumInfoTitle)

         

          bool = swCustPropMgr.Add("Description", True, val, vaout)

            

          swModel.ForceRebuild3 (False)

       

          swModel.Save

      End Sub

      -----------------------------------------------------------------

       

      It doesn't work though. I have been able to get the code to copy in the other direction (From custom property to summary property) using the following code:

      -----------------------------------------------------------------

      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("Description", False, val, valout)

       

          swModel.SummaryInfo(swSumInfoTitle) = valout

       

        

       

          swModel.ForceRebuild3 (False)

       

          swModel.Save

      End Sub

      -----------------------------------------------------------------

      Any help resolving this would be most apriciated!

      Thanks

      Kevin

        • Re: Copy summary property to custom property
          Matt Martens

          You want to place the string to be entered in the val argument, not the valout. The valout is read-only because the software evaluates whatever has been entered into the val field.

          • Re: Copy summary property to custom property
            Kevin Tate

            I just thought I would post an update. I've used some other code I found else ware to add to the previous code to create a macro that loops through all files in a folder and copies text from multiple locations to the new custom properties. Thought this may be useful to anyone else searching this subject.

            Kevin

            ---------------------------------------

            Dim swApp As Object

            Dim Part As Object

            Dim boolstatus As Boolean

            Dim longstatus As Long, longwarnings As Long

             

             

            Dim swApp0 As SldWorks.SldWorks

            Dim swModel As SldWorks.ModelDoc2

            Const strFolderPath As String = "C:\custom\"

            Dim strFileName As String

             

             

            '------------------------------

            Dim SumTitle As String

            Dim SumAuthor As String

            Dim SumSubject As String

            Dim OldPartNo As String

            Dim CustTitle As String

            Dim CustAuthor As String

            Dim CustSubject As String

            Dim CustPartNo As String

             

             

            '------------------------------

            Sub main0()

                Set swApp0 = Application.SldWorks

                strFileName = Dir(strFolderPath & "*.SLDPRT")

                While strFileName <> ""

                    Set swModel = swApp0.OpenDoc6(strFolderPath & strFileName, swDocPART, 1, Empty, Empty, Empty)

                    Set swApp = CreateObject("SldWorks.Application")

                    Set swModel = swApp.ActiveDoc

             

             

            '------------------------------

            'Old Properties

                SumTitle = swModel.SummaryInfo(swSumInfoTitle)

                SumAuthor = swModel.SummaryInfo(swSumInfoAuthor)

                SumSubject = swModel.SummaryInfo(swSumInfoSubject)

                OldPartNo = swModel.CustomInfo("SW-Part Number")

             

            'New Properties

                CustTitle = swModel.CustomInfo("[SW-Title]")

                CustAuthor = swModel.CustomInfo("Author")

                CustSubject = swModel.CustomInfo("[SW-Subject]")

                CustPartNo = swModel.CustomInfo("[SW-Part Number]")

             

            'Title Convert

                CustTitleValue = CustTitle

                If CustTitleValue <> "" Then

                CustTitle = SumTitle

                Else

                swModel.AddCustomInfo3 "", "[SW-Title]", swCustomInfoText, SumTitle

                End If

             

            'Author Convert

                CustAuthorValue = CustAuthor

                If CustTitleValue <> "" Then

                CustAuthor = SumAuthor

                Else

                swModel.AddCustomInfo3 "", "Author", swCustomInfoText, SumAuthor

                End If

             

            'Subject Convert

                CustSubjectValue = CustSubject

                If CustTitleValue <> "" Then

                CustSubject = SumSubject

                Else

                swModel.AddCustomInfo3 "", "[SW-Subject]", swCustomInfoText, SumSubject

                End If

             

            'Part Number Convert

                CustPartNoValue = CustPartNo

                If CustTitleValue <> "" Then

                CustPartNo = OldPartNo

                Else

                swModel.AddCustomInfo3 "", "[SW-Part Number]", swCustomInfoText, OldPartNo

                End If

            '------------------------------

                  swModel.ForceRebuild3 (False)

               

               

                    swModel.Save3 1, Empty, Empty

                    swApp0.QuitDoc swModel.GetTitle

                    strFileName = Dir

             

             

                Wend

                swApp0.ExitApp

            End Sub