17 Replies Latest reply on Nov 25, 2015 5:34 PM by Kevin Chisholm Branched to a new discussion.

    Save As... Macro

    Kevin Chisholm

      Hi everyone,

       

      First off, I am really new at making macro's so sorry for the beginner questions!

      I've been reading plenty of macros that where already created but can't seem to make heads

      or tails on which one to modify for our application.

       

      We use parts with names like US-065000-00.SLDPRT (US-065000-00.SLDDRW) with mirror

      parts that have a "M" that's added to the name: US-065000M-00.SLDPRT (US-065000M-00.SLDDRW)

       

      We have a few in-house steps we also have to do before before creating a revision of a part.

      Mostly clicking boxes that says a revision exist of a certain part.

      I'm trying to write a Macro that will do these steps:

       

      With US-065000.00.SLDPRT opened in solidworks, launch macro to open US-065000-00.SLDDRW

      and US-065000M-00.SLDPRT if it exists with it's drawing US-065000M-00.SLDDRW.

       

      Once all are openned, we would need to check this option in our custom properties for the .SLDPRT's:

      Then save all 4 documents in this order US-065000M-01.SLDDRW, US-065000M-01.SLDPRT,US-065000-01.SLDDRW, US-065000-01.SLDPRT.

      They would be saved in the same folder as the original file.

       

      After that, I would change Revision box in Custom properties and set original part to US-065000-00.

       

      I wish my colleagues would have started me off with an easier macro to write like opening a new document.

       

      Any help will be greatly appreciated!! I'll continue searching to see if I can't figure this out!

       

      Thank you for your time,

      Kevin Chisholm

        • Re: Save As... Macro
          Kevin Chisholm

          Update:

           

          I've been reading a lot and been playing with my macro today.

          I got the SaveAs function to work but the revision part seems out of my knowledge.

          This is where I'm stuck:

           

          Dim Revision As String

          Dim NewRev As String

           

          Revision = swModel.CustomInfo("revision")

          NewRev = Revision + 1

           

          The new US # it gives me is US-065000-1.SLDPRT and not US-065000-01.SLDPRT

           

          As I cannot add + 01 to NewRev how could I make it increment while keeping the "0"?

           

          I know I could add this

          swModel.SaveAs (FilePath + partnumber + "-" + "0" + NewRev + ".sldprt")

          but if we ever it a 10th revision it wouldn't show up properly.

           

          Well going back to it to figure out more of the things I need to do!

           

          Thanks for any help!

          Kevin Chisholm

            • Re: Save As... Macro
              Tapani Sjoman

                  Dim revNumber As Integer

               

                  If IsNumeric(Revision) Then
                      revNumber = CInt(Revision) + 1
                  Else
                      revNumber = 0 + 1
                  End If

               

                   If revNumber > 9 Then
                      NewRev = CStr(revNumber)
                  Else
                      NewRev = "0" & CStr(revNumber)
                  End If

                • Re: Save As... Macro
                  Kevin Chisholm

                  Thanks Tapani!

                   

                  That works like a charm!

                   

                  I can now open drawing of US-065000-00.SLDPRT and save both files

                  to revision -01...

                   

                  Now I need to figure out how to open the mirror part "M".

                  Thought I could use the same code as opening the drawing but it seems like

                  it doesn't work. I'll try and figure it out!

                   

                  I think I'm only missing the code to open "partnumber + M"... in the same path.

                   

                  I'll update the thread to show my progress at the end of the day!

                   

                  Thanks again Tapani!

                   

                  Kevin Chisholm

                • Re: Save As... Macro
                  Kevin Chisholm

                  Update:

                   

                  I believe that I'm stuck once again.

                   

                  I have my windows open like this: us-065000-00.sldprt, us-065000-00.slddrw, us-065000M-00.sldprt, us-065000M-00.slddrw.

                   

                  With the us-065000M-00.slddrw opened, to I need to switch back to us-065000-00.sldprt to make changes to that part??

                   

                  How can I switch the active window in solidworks to show the exact part that I want to show/modify?

                   

                  Thanks for the help once again!

                  Kevin Chisholm

                • Re: Save As... Macro
                  Kevin Chisholm

                  Update:

                   

                  I'm surprised... It works!! *****(EDIT: Almost!! )******

                   

                  I just need to test it when a mirror part doesn't exist to see if I need to skip steps...?!?

                  *****EDIT: Well works when a Mirror part is present... Not otherwise. Looking for a way to skip

                  lines if Model doesn't exist... Any help would be welcomed!! Thanks!*****

                   

                  All input or improvement that can be made, please let me know!

                   

                  Here it is:

                  Dim swApp As SldWorks.SldWorks
                  Dim swModel As SldWorks.ModelDoc2
                  Dim swModel2 As SldWorks.ModelDoc2
                  Dim swModel3 As SldWorks.DrawingDoc
                  Dim swModel4 As SldWorks.DrawingDoc
                  
                  
                  Dim partnumber As String
                  Dim partnumber2 As String
                  Dim partnumber3 As String
                  Dim partnumber4 As String
                  
                  
                  Dim Revision As String
                  Dim NewRev As String
                  Dim revNumber As Integer
                  
                  
                  Dim lngErrors As Long
                  Dim lngWarnings As Long
                  
                  
                  
                  
                  Sub main()
                  
                  
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc
                      
                      'Regular Part Info
                      partnumber = swModel.CustomInfo("stdnumber")
                      Revision = swModel.CustomInfo("revision")
                      PathName = swModel.GetPathName
                      FilePath = Left(PathName, InStrRev(PathName, "\"))
                              
                      'New Revision Number
                      If IsNumeric(Revision) Then
                          revNumber = CInt(Revision) + 1
                      Else
                          revNumber = 0 + 1
                      End If
                  
                       If revNumber > 9 Then
                          NewRev = CStr(revNumber)
                      Else
                          NewRev = "0" & CStr(revNumber)
                      End If
                  '===================================================================================================
                      'Open all Documents
                      
                      'Regular Drawing Open
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      partnumber2 = Left$(swModel.GetPathName, (Len(swModel.GetPathName) - 6)) & "SLDDRW"
                      If fso.FileExists(partnumber2) Then
                      Set swModel3 = swApp.OpenDoc(partnumber2, swDocDRAWING)
                      Else: MsgBox ("Drawing does not exist!")
                      End If
                      
                      'Mirror Part Open
                      partnumber3 = partnumber + "M"
                      Set swModel2 = swApp.OpenDoc6(FilePath + partnumber3 + "-" + Revision + ".SLDPRT", swDocPART, 0, "", lngErrors, lngWarnings)
                                 
                      'Mirror Drawing Open
                      partnumber4 = partnumber + "M"
                      Set swModel4 = swApp.OpenDoc6(FilePath + partnumber4 + "-" + Revision + ".SLDDRW", swDocDRAWING, 0, "", lngErrors, lngWarnings)
                      
                  '===================================================================================================
                      
                      'Change Custom Properties (Revision Exists)
                              
                           
                      swModel.CustomInfo("RevisionExists") = "X"
                      
                      swModel.ClearSelection2 True
                      swModel.ViewZoomtofit2
                      swModel.ForceRebuild3 False
                      swModel.Save2 Silent
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swModel2.CustomInfo("RevisionExists") = "X"
                         
                      swModel2.ClearSelection2 True
                      swModel2.ViewZoomtofit2
                      swModel2.ForceRebuild3 False
                      swModel2.Save2 Silent
                             
                      End If
                      
                      
                  '===================================================================================================
                      'Save as...
                      
                      'Mirror Drawing
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber4 + "-" + Revision + ".SLDDRW") Then
                      swModel4.SaveAs (FilePath + partnumber + "M" + "-" + NewRev + ".SLDDRW")
                      End If
                      
                      'Mirror Part
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swModel2.SaveAs (FilePath + partnumber + "M" + "-" + NewRev + ".SLDPRT")
                      End If
                      
                      'Regular Drawing
                      swModel3.SaveAs (FilePath + partnumber + "-" + NewRev + ".SLDDRW")
                      
                      'Regular Part
                      swModel.SaveAs (FilePath + partnumber + "-" + NewRev + ".SLDPRT")
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber4 + "-" + Revision + ".SLDDRW") Then
                      swModel4.ClearSelection2 True
                      swModel4.ViewZoomtofit2
                      swModel4.ForceRebuild3 False
                      swModel4.Save2 Silent
                      End If
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swModel2.ClearSelection2 True
                      swModel2.ViewZoomtofit2
                      swModel2.ForceRebuild3 False
                      swModel2.Save2 Silent
                      End If
                      
                      swModel3.ClearSelection2 True
                      swModel3.ViewZoomtofit2
                      swModel3.ForceRebuild3 False
                      swModel3.Save2 Silent
                      
                      swModel.ClearSelection2 True
                      swModel.ViewZoomtofit2
                      swModel.ForceRebuild3 False
                      swModel.Save2 Silent
                      
                  '===================================================================================================
                  
                  
                      'Change Custom Properties
                      
                      swModel.CustomInfo("RevisionExists") = ""
                      swModel.CustomInfo("origin") = partnumber + "-" + Revision
                      swModel.CustomInfo("Revision") = NewRev
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swModel2.CustomInfo("RevisionExists") = ""
                      swModel2.CustomInfo("origin") = partnumber + "M" + "-" + Revision
                      swModel2.CustomInfo("Revision") = NewRev
                      End If
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber4 + "-" + Revision + ".SLDDRW") Then
                      swModel4.ClearSelection2 True
                      swModel4.ViewZoomtofit2
                      swModel4.ForceRebuild3 False
                      swModel4.Save2 Silent
                      End If
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swModel2.ClearSelection2 True
                      swModel2.ViewZoomtofit2
                      swModel2.ForceRebuild3 False
                      swModel2.Save2 Silent
                      End If
                      
                      swModel3.ClearSelection2 True
                      swModel3.ViewZoomtofit2
                      swModel3.ForceRebuild3 False
                      swModel3.Save2 Silent
                      
                      swModel.ClearSelection2 True
                      swModel.ViewZoomtofit2
                      swModel.ForceRebuild3 False
                      swModel.Save2 Silent
                  '===================================================================================================
                  
                  
                      'Close Documents
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber3 + "-" + Revision + ".SLDPRT") Then
                      swApp.QuitDoc swModel2.GetTitle
                      End If
                      
                      swApp.QuitDoc swModel3.GetTitle
                      
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      If fso.FileExists(FilePath + partnumber4 + "-" + Revision + ".SLDDRW") Then
                      swApp.QuitDoc swModel4.GetTitle
                      End If
                          
                  End Sub
                  
                  • Re: Save As... Macro
                    Kevin Chisholm

                    Hi everyone!

                     

                    I will be cleaning up my macro today but I just realized that I need to make it "fool proof"...

                     

                    At the beginning of the Macro, would it be possible to add these features?

                     

                    1- If .SLDASM or .SLDDRW document is opened, a message would appear to notify user that wrong file is opened and the macro would end.

                     

                    2- We use SA-065000-00.SLDASM, any way to exclude SA- assemblies from that first "If" statement?

                     

                    Thank you for your time!

                    Kevin Chisholm

                      • Re: Save As... Macro
                        Deepak Gupta

                        Try these codes

                         

                        Option Explicit

                        Dim swApp           As SldWorks.SldWorks

                        Dim swModel         As SldWorks.ModelDoc2

                         

                        Sub main()

                        Set swApp = Application.SldWorks

                        Set swModel = swApp.ActiveDoc   

                        If swModel.GetType <> swDocPART And Left(UCase(swModel.GetTitle), 2) <> "SA" Then

                            MsgBox "Only allowed on parts or specific assemblies"

                        End If

                        End Sub

                          • Re: Save As... Macro
                            Kevin Chisholm

                            Thanks Deepak!

                            I will give it a try on Monday when I'm back at work.

                             

                            I see what you did there (I think)...

                            "If solidworks model is something else than a part and if the title doesn't start with SA for the two first letters of the title then it isn't allowed." Right?

                             

                            I'll need to read about the "Left" command since I have no knowledge of the codes. This is my first ever macro.

                             

                            Thanks again Deepak!! Helps a lot!

                            Kevin Chisholm

                              • Re: Save As... Macro
                                Deepak Gupta

                                Kevin Chisholm wrote:

                                 

                                "If solidworks model is something else than a part and if the title doesn't start with SA for the two first letters of the title then it isn't allowed." Right?

                                Yes. The active file either needs to be a part OR in case of assembly, the file name should have SA as first two letters.

                                  • Re: Save As... Macro
                                    Kevin Chisholm

                                    Hi Deepak,

                                     

                                    I just tried the codes you gave me and there seems to be a problem.

                                     

                                    I set swModel to ActiveDoc and swModel = Dim ModelDoc2...

                                    But I don't have an ModelDoc2 opened, I have a AssemblyDoc.

                                    I think I need more conditions with a line similar to this : Dim swAssem As SldWorks.AssemblyDoc?!?

                                     

                                    Not sure about this one...

                                    Thanks for the help!

                                    Kevin Chisholm

                                      • Re: Save As... Macro
                                        Deepak Gupta

                                        Use  Dim swModel as Object. This is late binding but would solve the issue for you without adding any additional condition.

                                         

                                        But I've tried the above codes with both part and assembly open, and it worked fine as expected. Do you've anything set to PartDoc?

                                          • Re: Save As... Macro
                                            Kevin Chisholm

                                            I have this as code:

                                             

                                            Dim swApp As SldWorks.SldWorks

                                            Dim swModelReg As SldWorks.ModelDoc2

                                            Dim swModelMir As SldWorks.ModelDoc2

                                            Dim swDrawReg As SldWorks.DrawingDoc

                                            Dim swDrawMir As SldWorks.DrawingDoc

                                             

                                            Sub main()

                                             

                                                Set swApp = Application.SldWorks

                                                Set swModelReg = swApp.ActiveDoc

                                                If swModelReg.GetType <> swDocPART And Left(UCase(swModel.GetTitle), 2) <> "SA" Then

                                                MsgBox "Only allowed on Parts or SA assemblies"

                                                End If

                                             

                                            And it gives me an error on this line when I try to run it :

                                             

                                             

                                            I think I just found the problem... I didn't change the 2nd swModel.GetTitle to swModelReg.GetTitle... Sorry!

                                             

                                            The code works great!

                                             

                                            I'm guessing I need to set another Sub ***** () to stop the macro?

                                            Now it gives me the MsgBox but keeps running the rest of the macro...

                                             

                                            Would something like this work?

                                            Sub main()

                                             

                                                Set swApp = Application.SldWorks

                                                Set swModelReg = swApp.ActiveDoc

                                                If swModelReg.GetType <> swDocPART And Left(UCase(swModelReg.GetTitle), 2) <> "SA" Then

                                                MsgBox "Only allowed on Parts or SA assemblies"

                                                ElseIf swModelReg.GetType = swDocPART And Left(UCase(swModelReg.GetTitle), 2) = "SA" Then

                                                PartRev

                                                End If

                                                End Sub

                                             

                                             

                                            Function PartRev()

                                               

                                                Set swApp = Application.SldWorks

                                                Set swModelReg = swApp.ActiveDoc

                                                 [...] rest of the program...

                                             

                                            Thanks again!

                                            Kevin Chisholm

                                • Re: Save As... Macro
                                  Kevin Chisholm

                                  Hey everyone!!

                                   

                                  I'm trying to add this "Loop" in my program to "Verify" if a revision already exists before creating

                                  another file and saving over top of it...

                                   

                                  Here is what I got but it crashes every single time...

                                   

                                  Dim Revision As String

                                  Dim NewRev As String

                                  Dim revNumber As Integer

                                  Dim RevExists As Boolean

                                   

                                  Set swApp = Application.SldWorks

                                      Set swModelReg = swApp.ActiveDoc

                                      Set fso = CreateObject("Scripting.FileSystemObject")

                                     

                                      'Regular Part Info

                                          partnumModReg = swModelReg.CustomInfo("stdnumber")

                                          Revision = swModelReg.CustomInfo("revision")

                                          PathName = swModelReg.GetPathName

                                          FilePath = Left(PathName, InStrRev(PathName, "\"))

                                   

                                       'New Revision Number

                                      Do

                                      If IsNumeric(Revision) Then

                                          revNumber = CInt(Revision) + 1

                                      Else

                                          revNumber = 1

                                      End If

                                   

                                       If revNumber > 9 Then

                                          NewRev = CStr(revNumber)

                                      Else

                                          NewRev = "0" & CStr(revNumber)

                                      End If

                                     

                                      'New Revision Verification

                                      If fso.FileExists(FilePath + partnumModReg + "-" + NewRev + ".SLDPRT") Then

                                          RevExists = True

                                      End If

                                      Loop Until RevExists = False

                                   

                                  Thank you for any help!!

                                  Kevin Chisholm

                                    • Re: Save As... Macro
                                      Kevin Chisholm

                                      Sorry for the last post...

                                      I figured it out...

                                       

                                          'New Revision Number

                                         

                                          If IsNumeric(Revision) Then

                                              revNumber = CInt(Revision)

                                          Else

                                              revNumber = 1

                                          End If

                                       

                                          Do

                                          revNumber = revNumber + 1

                                       

                                          If revNumber > 9 Then

                                              NewRev = CStr(revNumber)

                                          Else

                                              NewRev = "0" & CStr(revNumber)

                                          End If

                                       

                                          Set fso = CreateObject("Scripting.FileSystemObject")

                                          Loop Until Not fso.FileExists(FilePath + partnumModReg + "-" + NewRev + ".SLDPRT")

                                       

                                      I'll try to be more patient before posting a question next time!!

                                       

                                      Have a great day!

                                      Kevin Chisholm