AnsweredAssumed Answered

VBA - SaveAs files dialog issue (IGES)

Question asked by Danniel Sims on Apr 27, 2016
Latest reply on Apr 27, 2016 by John Alexander

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

 

Outcomes