10 Replies Latest reply on Apr 11, 2016 9:36 AM by Deepak Gupta

    Macro Help: Pack and go With drawings and change name to property

    Anton Miller

      Hello,

       

      I am in need of some help to write a macro for doing a pack and go and having the names changed to a series of properties.  Also include all drawings.  I feel like the real hard part for me is the change names to a series of custom property.

       

      Thank you.

          • Re: Macro Help: Pack and go With drawings and change name to property
            Anton Miller

            Awesome link!

             

            unless I am missing something, is there a portion to add the renaming to a series of properties in that?

                • Re: Macro Help: Pack and go With drawings and change name to property
                  Anton Miller

                  Deepak!!!  This worked really well...  except I cant find where the macro changes the names.  my models seems to be going to a "KB_65_1" and counting up from there.  but my drawings do not change names...  If I cant get them both to change names and get it to pull from a custom property I think its everything I could ever need.

                   

                  Const strOutputPath As String = "C:\"
                  Const strCustProp As String = "Index"

                   

                  Sub main()
                      Dim swApp As SldWorks.SldWorks
                      Dim swModel As SldWorks.ModelDoc2
                      Dim swCompModel As SldWorks.ModelDoc2
                      Dim swCustPropMgr As SldWorks.CustomPropertyManager
                      Dim swPackAndGo As SldWorks.PackAndGo
                      Dim strValOut As String
                      Dim strFileExt As String
                      Dim intDocCount As Integer
                      Dim vPathNames As Variant
                      Dim strSetPathNames() As String
                      Dim i As Integer
                      Dim vStatus As Variant
                      Dim strRetVal As String
                      Dim Number      As String

                   


                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc

                   

                      'Error handling
                      If swModel Is Nothing Then
                          swApp.SendMsgToUser "Please open an assembly or drawing."
                          Exit Sub
                      ElseIf swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocDRAWING Then
                          swApp.SendMsgToUser "Please open an assembly or drawing."
                          Exit Sub
                      End If

                   

                   

                   

                     'Number = InputBox("Ordner Benennung")

                     'If Number = "" Then

                      'MsgBox "Please enter number"

                     ' Else

                   

                      'Get IPackAndGo object
                      Set swPackAndGo = swModel.Extension.GetPackAndGo

                   

                      'Resize the set paths array
                      intDocCount = swPackAndGo.GetDocumentNamesCount
                      ReDim strSetPathNames(intDocCount - 1) As String

                   

                   

                   

                      'Get the current document paths and append the Revision custom property
                      swPackAndGo.GetDocumentNames vPathNames
                      For i = 0 To UBound(vPathNames)
                          strSetPathNames(i) = vPathNames(i)

                   

                          'The document should be open in memory, so get it
                          Set swCompModel = swApp.GetOpenDocumentByName(strSetPathNames(i))
                          If Not swCompModel Is Nothing Then
                              'Get the custom property value
                              Set swCustPropMgr = swCompModel.Extension.CustomPropertyManager(Empty)
                              swCustPropMgr.Get4 strCustProp, True, Empty, strValOut

                   

                          End If

                   


                              strSetPathNames(i) = "KB_65_" & Number & "_" & i & Right(strSetPathNames(i), Len(strSetPathNames(i)) - InStrRev(strSetPathNames(i), ".") + 1)
                              Debug.Print strSetPathNames(i)

                   

                   

                   


                      Next i

                   

                      'Set the save paths
                      swPackAndGo.SetDocumentSaveToNames strSetPathNames

                   


                      Dim sOutputPath      As String
                      If Dir(strOutputPath & "\" & Number, vbDirectory) = "" Then
                          MkDir strOutputPath & "\" & Number
                      End If
                      sOutputPath = strOutputPath & "\" & Number

                   

                      'IPackAndGo::SetSaveToName is needed for two reasons. First, it is needed for _
                          IPackAndGo::IncludeDrawings to work. Second, it is needed if the pack and go _
                          is to result in a .zip file. Also note that in this example, at least, I am not _
                          able to see any difference between Override being True or False
                      swPackAndGo.SetSaveToName True, sOutputPath

                   

                      'Include drawings
                      swPackAndGo.IncludeDrawings = True

                   

                      'Save the pack and go
                      vStatus = swModel.Extension.SavePackAndGo(swPackAndGo)

                   


                      'End If
                  End Sub

                  • Re: Macro Help: Pack and go With drawings and change name to property
                    Anton Miller

                    In bold is what I think needs to be "fixed" but im not 100% sure...  that is where the file name was coming from.  with my changes, all I get is a lower case full file name of what it was.

                     

                     

                     

                    Const strOutputPath As String = "C:\myloadpoint\"
                    Const strCustProp As String = "Index"

                    Sub main()
                        Dim swApp As SldWorks.SldWorks
                        Dim swModel As SldWorks.ModelDoc2
                        Dim swCompModel As SldWorks.ModelDoc2
                        Dim swCustPropMgr As SldWorks.CustomPropertyManager
                        Dim swPackAndGo As SldWorks.PackAndGo
                        Dim strValOut As String
                        Dim strFileExt As String
                        Dim intDocCount As Integer
                        Dim vPathNames As Variant
                        Dim strSetPathNames() As String
                        Dim i As Integer
                        Dim vStatus As Variant
                        Dim strRetVal As String
                        Dim Number      As String
                        Dim Title1      As String
                        Dim Title2      As String
                        Dim Title3      As String
                        Dim USE      As String


                        Set swApp = Application.SldWorks
                        Set swModel = swApp.ActiveDoc

                        'Error handling
                        If swModel Is Nothing Then
                            swApp.SendMsgToUser "Please open an assembly or drawing."
                            Exit Sub
                        ElseIf swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocDRAWING Then
                            swApp.SendMsgToUser "Please open an assembly or drawing."
                            Exit Sub
                        End If

                       'Number = InputBox("Ordner Benennung")

                       'If Number = "" Then

                        'MsgBox "Please enter number"

                       ' Else

                        'Get IPackAndGo object
                        Set swPackAndGo = swModel.Extension.GetPackAndGo

                        'Resize the set paths array
                        intDocCount = swPackAndGo.GetDocumentNamesCount
                        ReDim strSetPathNames(intDocCount - 1) As String



                        'Get the current document paths and append the Revision custom property
                        swPackAndGo.GetDocumentNames vPathNames
                        For i = 0 To UBound(vPathNames)
                            strSetPathNames(i) = vPathNames(i)

                            'The document should be open in memory, so get it
                            Set swCompModel = swApp.GetOpenDocumentByName(strSetPathNames(i))
                            If Not swCompModel Is Nothing Then
                                'Get the custom property value
                                Set swCustPropMgr = swCompModel.Extension.CustomPropertyManager(Empty)
                                swCustPropMgr.Get4 strCustProp, True, Empty, strValOut
                    Title1 = swCompModel.CustomInfo("TITLE1")
                            Title2 = swCompModel.CustomInfo("TITLE2")
                            Title3 = swCompModel.CustomInfo("TITLE3")
                            USE = swCompModel.CustomInfo("USE")
                       
                            End If
                       
                                           
                                strSetPathNames(i) = ("Title1") + ("Title2") + ("Title3") + ("USE")
                                Debug.Print strSetPathNames(i)




                        Next i

                        'Set the save paths
                        swPackAndGo.SetDocumentSaveToNames strSetPathNames


                        Dim sOutputPath      As String
                        If Dir(strOutputPath & "\" & Number, vbDirectory) = "" Then
                            MkDir strOutputPath & "\" & Number
                        End If
                        sOutputPath = strOutputPath & "\" & Number

                        'IPackAndGo::SetSaveToName is needed for two reasons. First, it is needed for _
                            IPackAndGo::IncludeDrawings to work. Second, it is needed if the pack and go _
                            is to result in a .zip file. Also note that in this example, at least, I am not _
                            able to see any difference between Override being True or False
                        swPackAndGo.SetSaveToName True, sOutputPath

                        'Include drawings
                        swPackAndGo.IncludeDrawings = True

                        'Save the pack and go
                        vStatus = swModel.Extension.SavePackAndGo(swPackAndGo)


                        'End If
                    End Sub