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.
Thanks
SolidworksApi macrosOption 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
