4 Replies Latest reply on Apr 27, 2016 3:24 PM by John Alexander

    VBA - SaveAs files dialog issue (IGES)

    Danniel Sims

      Okay, so I have a macro that I have to save me lots of time.  I have to save out component parts of an assembly to STEP, STL, IGES, and Parasolid filetypes for CADCAM software.  It turns off each part of the assembly and saves it out to specific folders, then it reassembles the output files to verify the new coordinate system is correct. Everything works except I get a pop-up that I can't seem to get rid of on the SAVEAS for the IGES files.  This was two macros I joined into one, so there may be now unused variables at the top of the code.

       

      I have tried forcing the user preferences toggle to false, but it always comes out of the line as true.  The bad line was in Settings sub, but I tried moving it to directly above the saveas (highlighted in red).

       

      I'm not sure what I'm doing wrong, or if it is my version.  I am using Solidworks 2007 (I know it's old, but it's what I'm stuck with).

       

      If I can bypass this pop-up I can totally automate this with a push of a button.

       

      popup.png

       

      Thanks

       

      Option Explicit

       

       

      Dim swApp As Object

      Dim Part As Object

      Dim SubPart As Object

      Dim SelMgr As Object

      Dim swComp As Object

      Dim swModel As Object

      Dim swModelDocExt As Object

      Dim swFeatMgr As Object

      Dim count As Long

      Dim featArr As Variant

      Dim swModeler As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim Feature As Object

      Dim swModelDoc As SldWorks.ModelDoc2

      Dim nam, a, newdoc, loc, locsplit, cur_assembly, build, buildc, asmPath, asmFile, asmSplit

      Dim doc_nam, doc_split, doc_count, doc_path, d

      Dim t, obType, bRet, obnam, assemble, las, abbrev

      Dim featnam, featl

      Dim ms_x_t, ms_iges, ms_stl, ms_step

      Public fso, f, f1, fc, fs, fs2, OCS, SetOCS, IGS, SetIGS, STL, SetSTL, i

       

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

      Sub Settings()

       

       

      Set swApp = Application.SldWorks

      Set swModeler = swApp.GetModeler

      Set swModel = swApp.ActiveDoc

       

       

      'IGES PREF

       

       

      swApp.SetUserPreferenceToggle swIGESComponentsIntoOneFile, True

      swApp.SetUserPreferenceToggle swIGESExportSolidAndSurface, True

      swApp.SetUserPreferenceToggle swIGESFlattenAssemHierarchy, True

      swApp.SetUserPreferenceToggle swIGESHighTrimCurveAccuracy, True

      swApp.SetUserPreferenceToggle swIGESComponentsIntoOneFile, True

       

       

      'STL PREF

       

       

      swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, True

      swApp.SetUserPreferenceToggle swSTLShowInfoOnSave, False

      swApp.SetUserPreferenceToggle swSTLBinaryFormat, True

      swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, False

      swApp.SetUserPreferenceToggle swSTLDontTranslateToPositive, True

      swApp.SetUserPreferenceToggle swSTLPreview, False

       

       

      'PARASOLID PREF

       

       

      swApp.SetUserPreferenceToggle swParasolidOutputVersion_160, True

      swApp.SetUserPreferenceToggle swXTAssemSaveFormat, True

       

       

      'STEP PREF

                            

      End Sub

      Sub ExitSettings()

       

       

      Set swApp = Application.SldWorks

      Set swModeler = swApp.GetModeler

      Set swModel = swApp.ActiveDoc

       

       

      'PARASOLID PREF

       

       

      swApp.SetUserPreferenceToggle swParasolidOutputVersion_latest, True

      swApp.SetUserPreferenceToggle swXTAssemSaveFormat, False

       

       

      'STEP PREF

                            

      End Sub

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

       

      Sub Interference_3D_Save()

       

       

      Set swApp = Application.SldWorks

      Set swModeler = swApp.GetModeler

      Set swModel = swApp.ActiveDoc

      Set swModelDocExt = swModel.Extension

      Set swFeatMgr = swModel.FeatureManager

      count = swFeatMgr.GetFeatureCount(True)

      featArr = swFeatMgr.GetFeatures(True)

      Set SelMgr = swModel.SelectionManager

      Dim starttime, endtime, ttime

      Dim doc_nam, doc_split, doc_count, doc_path, d

      Dim t, obType, bRet, obnam, assemble, las, abbrev

      Dim featnam, featl

      Dim ms_x_t, ms_iges, ms_stl, ms_step

      Dim CADCAM

       

       

       

       

      starttime = Now

      'IS FILE OPEN?

       

       

      If swModel Is Nothing Then

          Exit Sub

      End If

       

       

      ' SET USER PREFERENCES

      Settings

       

       

       

       

      'GET FILE PATH

       

       

      doc_nam = swModel.GetPathName

       

       

      doc_split = Split(doc_nam, "\")

      doc_count = UBound(doc_split)

      doc_path = ""

      d = 0

       

       

      Do Until d = doc_count

          doc_path = doc_path & doc_split(d) & "\"

      d = d + 1

      Loop

       

       

      loc = doc_path

       

       

      ' CHECK IF FOLDERS EXIST - CREATE NEW IF FALSE

         

          Set fso = CreateObject("Scripting.FileSystemObject")

         

          If fso.FolderExists(doc_path & "IGS") = False Then

              fso.CreateFolder (doc_path & "IGS")

              fso.CreateFolder (doc_path & "IGS\SW")

          End If

       

       

          If fso.FolderExists(doc_path & "STEP") = False Then

              fso.CreateFolder (doc_path & "STEP")

              fso.CreateFolder (doc_path & "STEP\SW")

          End If

       

       

          If fso.FolderExists(doc_path & "STL") = False Then

              fso.CreateFolder (doc_path & "STL")

              fso.CreateFolder (doc_path & "STL\SW")

          End If

         

          If fso.FolderExists(doc_path & "x_t") = False Then

              fso.CreateFolder (doc_path & "x_t")

              fso.CreateFolder (doc_path & "x_t\SW")

          End If

         

      'GET COORDINATE SYSTEM NAME

         

      i = 1

       

       

      Do Until i = count

          If featArr(i).GetTypeName = "CoordSys" Then

              CADCAM = featArr(i).Name

              GoTo HideStep

          End If

      i = i + 1

      Loop

       

       

      MsgBox "There is no Coordinate System added to this assembly.", vbCritical

      Exit Sub

         

      'HIDE ALL COMPONENTS BETWEEN ORIGIN AND MATES

       

       

      HideStep:

       

       

      i = 1

       

       

      Do Until i = count

          If featArr(i).GetTypeName = "MateGroup" Then

              Exit Do

          Else

              If featArr(i).GetTypeName = "OriginProfileFeature" Then

                  i = i + 1

                  Do Until featArr(i).GetTypeName = "MateGroup"

                 

                      assemble = doc_split(UBound(doc_split))

                      las = Len(assemble) - 7

                      abbrev = Left(assemble, las)

                      obnam = featArr(i).Name & "@" & abbrev

                      bRet = swModel.Extension.SelectByID2(obnam, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

                      swModel.HideComponent2

                 

                  i = i + 1

                  Loop

                 

              End If

          End If

       

       

      i = i + 1

      Loop

       

       

       

       

      ' UNHIDE EACH ASSEMBLY AND SAVE AS EACH FILETYPE IN EACH APPROPRIATE FOLDER

                     

      i = 1

       

       

      Do Until i = count

          If featArr(i).GetTypeName = "MateGroup" Then

              Exit Do

          Else

              If featArr(i).GetTypeName = "OriginProfileFeature" Then

                  i = i + 1

                  Do Until featArr(i).GetTypeName = "MateGroup"

                 

                      assemble = doc_split(UBound(doc_split))

                      las = Len(assemble) - 7

                      abbrev = Left(assemble, las)

                      obnam = featArr(i).Name & "@" & abbrev

                      bRet = swModel.Extension.SelectByID2(obnam, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

                      swModel.ShowComponent2

                     

                      featl = Len(featArr(i).Name) - 2

                      featnam = Left(featArr(i).Name, featl)

                     

                      'X_T

                     

                      'SET COORDINATE POSITION

                      OCS = swModel.GetUserPreferenceStringValue(swFileSaveAsCoordinateSystem)

                      'Debug.Print , OCS

       

       

                      swModel.SetUserPreferenceStringValue swFileSaveAsCoordinateSystem, CADCAM

                      swModel.SaveAs2 doc_path & "x_t\" & featnam & ".X_T", 0, True, False

                      swModel.SaveAs2 doc_path & "x_t\SW\" & featnam & "_XT.X_T", 0, True, False

       

       

                      'IGS

                      OCS = swModel.GetUserPreferenceStringValue(swFileSaveAsCoordinateSystem)

                      'Debug.Print , OCS

       

       

                      swModel.SetUserPreferenceStringValue swFileSaveAsCoordinateSystem, CADCAM

                     

                      'swApp.SetUserPreferenceToggle swIGESComponentsIntoOneFile, False

                     

                     

                      swModel.SaveAs2 doc_path & "IGS\" & featnam & ".IGS", 0, True, True

                      swModel.SaveAs2 doc_path & "IGS\SW\" & featnam & "_IGS.IGS", 0, True, True

       

       

                      'STL

                      OCS = swModel.GetUserPreferenceStringValue(swFileSaveAsCoordinateSystem)

                      'Debug.Print , OCS

       

       

                      swModel.SetUserPreferenceStringValue swFileSaveAsCoordinateSystem, CADCAM

                      swModel.SaveAs2 doc_path & "STL\" & featnam & ".STL", 0, True, False

                      swModel.SaveAs2 doc_path & "STL\SW\" & featnam & "_STL.STL", 0, True, False

                     

                      'STEP

                      OCS = swModel.GetUserPreferenceStringValue(swFileSaveAsCoordinateSystem)

                      'Debug.Print , OCS

       

       

                      swModel.SetUserPreferenceStringValue swFileSaveAsCoordinateSystem, CADCAM

                      swModel.SaveAs2 doc_path & "STEP\" & featnam & ".STEP", 0, True, False

                      swModel.SaveAs2 doc_path & "STEP\SW\" & featnam & "_STP.STEP", 0, True, False

                     

                       'REHIDE COMPONENT - GET NEXT

                      

                      swModel.HideComponent2

                   i = i + 1

                  Loop

                 

              End If

          End If

       

       

      i = i + 1

      Loop

       

       

      i = 1

       

       

      Do Until i = count

          If featArr(i).GetTypeName = "MateGroup" Then

              Exit Do

          Else

              If featArr(i).GetTypeName = "OriginProfileFeature" Then

                  i = i + 1

                  Do Until featArr(i).GetTypeName = "MateGroup"

                 

                      assemble = doc_split(UBound(doc_split))

                      las = Len(assemble) - 7

                      abbrev = Left(assemble, las)

                      obnam = featArr(i).Name & "@" & abbrev

                      bRet = swModel.Extension.SelectByID2(obnam, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

                      swModel.ShowComponent2

       

       

                 

                  i = i + 1

                  Loop

                 

              End If

          End If

       

       

      i = i + 1

      Loop

       

       

      'RESTORE PARASOLID SETTINGS TO NORMAL

      ExitSettings

       

       

      'BEGIN ASSEMBLY PROCESS

       

       

      Assemble_3D

       

       

       

       

      endtime = Now

      ttime = DateDiff("s", starttime, endtime)

       

       

      MsgBox "FILES SAVED IN " & ttime & " SECONDS!"

       

       

       

       

      End Sub

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

       

      Sub Assemble_3D()

       

       

      newdoc = "G:\SolidWorks\Design\SW2004\Templates\asm\Assembly.asmdot"

       

       

      locsplit = Split(loc, "\")

      a = UBound(locsplit) - 1

       

       

       

       

      buildc = 0

      Do Until buildc = 4 ' testing =1, normal =4

         

          If buildc = 0 Then

              build = "IGS"

          Else

              If buildc = 1 Then

                  build = "STEP"

              Else

                  If buildc = 2 Then

                      build = "STL"

                  Else

                      If buildc = 3 Then

                          build = "x_t"

                      Else

                          MsgBox "Bad count!", vbCritical

                          Exit Do

                      End If

                  End If

              End If

          End If

         

         

         

          Set swApp = Application.SldWorks

          Set Part = swApp.NewDocument(newdoc, 0, 0#, 0#)

          Part.SaveAs2 loc & build & "\SW\" & locsplit(a) & "_" & build & ".SLDASM", 0, False, False

          Set Part = swApp.ActiveDoc

          cur_assembly = locsplit(a) & "_" & build & ".SLDASM"

       

       

          asmPath = loc & build & "\SW\*" & build

          asmFile = Dir(asmPath)

       

       

          Do While asmFile <> ""

              asmSplit = Split(asmFile, ".")

             

              swApp.LoadFile2 loc & build & "\SW\" & asmFile, ""

              Set SubPart = swApp.ActiveDoc

             

              If build = "STL" Then

                  SubPart.SaveAs2 loc & build & "\SW\" & asmSplit(0) & ".SLDPRT", 0, False, False

                 

              Else

                  SubPart.SaveAs2 loc & build & "\SW\" & asmSplit(0) & ".SLDASM", 0, False, False

                 

              End If

             

              'Set SubPart = swApp.ActiveDoc

             

              If build = "STL" Then

                  Set SelMgr = Part.SelectionManager

                  Part.AddComponent loc & build & "\SW\" & asmSplit(0) & ".SLDPRT", 0, 0, 0

                  Part.ClearSelection2 True

                  boolstatus = Part.EditRebuild3

                  boolstatus = Part.SetUserPreferenceToggle(198, True)

                  Part.ViewZoomtofit2

                  swApp.CloseDoc asmSplit(0) & ".SLDPRT"

              Else

                  Set SelMgr = Part.SelectionManager

                  Part.AddComponent loc & build & "\SW\" & asmSplit(0) & ".SLDASM", 0, 0, 0

                  Part.ClearSelection2 True

                  boolstatus = Part.EditRebuild3

                  boolstatus = Part.SetUserPreferenceToggle(198, True)

                  Part.ViewZoomtofit2

                  swApp.CloseDoc asmSplit(0) & ".SLDASM"

              End If

             

       

       

       

       

       

       

              Part.ShowNamedView2 "*Isometric", 7

             

          asmFile = Dir()

          Loop

         

         

      'START MATE PROCESS LOOP HERE

       

       

          Set swModeler = swApp.GetModeler

          Set swModel = swApp.ActiveDoc

          Set swModelDocExt = swModel.Extension

          Set swFeatMgr = swModel.FeatureManager

          count = swFeatMgr.GetFeatureCount(True)

          featArr = swFeatMgr.GetFeatures(True)

       

       

       

       

      'GET FILE PATH

      doc_nam = swModel.GetPathName

       

       

      doc_split = Split(doc_nam, "\")

      doc_count = UBound(doc_split)

      doc_path = ""

      d = 0

       

       

      Do Until d = doc_count

          doc_path = doc_path & doc_split(d) & "\"

      d = d + 1

      Loop

       

       

      i = 1

       

       

      Do Until i = count

          If featArr(i).GetTypeName = "MateGroup" Then

              Exit Do

          Else

              If featArr(i).GetTypeName = "OriginProfileFeature" Then

                  i = i + 1

                  Do Until featArr(i).GetTypeName = "MateGroup"

                 

                      'GoTo filpath

                      assemble = doc_split(UBound(doc_split))

                      las = Len(assemble) - 7

                      abbrev = Left(assemble, las)

                      obnam = featArr(i).Name & "@" & abbrev

                      bRet = swModel.Extension.SelectByID2(obnam, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

                      swModel.UnfixComponent

                     

                      boolstatus = Part.Extension.SelectByID2("Right Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

                      boolstatus = Part.Extension.SelectByID2("Right Plane@" & obnam, "PLANE", 0, 0, 0, True, 0, Nothing, 0)

                      Set Feature = Part.AddMate3(swMateCOINCIDENT, swMateAlignALIGNED, False, 0, 0, 0, 0, 0, 0, 0, 0, False, longstatus)

                      Part.ClearSelection2 True

                      boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

                      boolstatus = Part.Extension.SelectByID2("Front Plane@" & obnam, "PLANE", 0, 0, 0, True, 0, Nothing, 0)

                      Set Feature = Part.AddMate3(swMateCOINCIDENT, swMateAlignALIGNED, False, 0, 0, 0, 0, 0, 0, 0, 0, False, longstatus)

                      Part.ClearSelection2 True

                      boolstatus = Part.Extension.SelectByID2("Top Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

                      boolstatus = Part.Extension.SelectByID2("Top Plane@" & obnam, "PLANE", 0, 0, 0, True, 0, Nothing, 0)

                      Set Feature = Part.AddMate3(swMateCOINCIDENT, swMateAlignALIGNED, False, 0, 0, 0, 0, 0, 0, 0, 0, False, longstatus)

                      Part.ClearSelection2 True

                      Part.ViewZoomtofit2

       

       

                  i = i + 1

                  Loop

                 

              End If

          End If

       

       

      i = i + 1

      Loop

       

       

       

       

         

      Part.SaveAs2 loc & build & "\SW\" & locsplit(a) & "_" & build & ".SLDASM", 0, False, False

       

       

       

       

      buildc = buildc + 1

      Loop

       

       

      swApp.ArrangeWindows 2

       

       

       

       

       

       

       

       

      End Sub