Hi, I am a part of Clemson BAJA SAE. I am designing a rear suspension and I need to analyze graphs like camber gain and wheel paths. Thus I want to export the result plots to a CVS file with a macro. I can not do this by hand since my plan is to run an algorithm that continues to update and improve the suspension design based on the results of the motion study.
boolstatus = swCosmosMotionStudyResults.ExportCSVFile(plotFeatures(2), "C:\Users\Matt\Desktop\Baja 2019-2020\Programming_For_Design\Trace Path1.csv")
All I need is for this line to work. It does not throw an error, but it does not export the file. I believe I correctly got the plot features because the size of the array is 3. However, when accessing GetTypeName I get this run time error. This makes me scratch my head because a type mismatch error was not thrown when initializing plotFeatures as an IFeature object and GetTypeName is a method of the IFeature object, which makes me think plotFeatures is corrupted in some way.
Thank you for any help!!
Sub main()
Debug.Print String(255, vbNewLine)
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swMotionMgr As SwMotionStudy.MotionStudyManager
Dim swMotionStudy1 As SwMotionStudy.MotionStudy
Dim swResults As SwMotionStudy.MotionStudyResults
Dim swMotionStudyProps As SwMotionStudy.MotionStudyProperties
Dim swCosmosMotionStudyProps As SwMotionStudy.CosmosMotionStudyProperties
Dim swCosmosMotionStudyResults As ICosmosMotionStudyResults
Dim boolstatus As Boolean
Dim swSelMgr As SelectionMgr
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swMotionMgr = swModelDocExt.GetMotionStudyManager()
If (swMotionMgr Is Nothing) Then
End
End If
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
Set swMotionStudy1 = swMotionMgr.GetMotionStudy("PhysSim")
If (swMotionStudy1 Is Nothing) Then
MsgBox "PhysSim is not available."
End
End If
swMotionStudy1.StudyType = 4
If Not swMotionStudy1.IsActive Then
swMotionStudy1.Activate
End If
Set swMotionStudyProps = swMotionStudy1.GetProperties(4)
Set swCosmosMotionStudyProps = swMotionStudyProps
Set swCosmosMotionStudyResults = swMotionStudy1.GetResults(4)
Call swMotionStudy1.Calculate
Dim numPlots As Integer
numPlots = swCosmosMotionStudyResults.GetPlotCount()
Debug.Print " Number of plots: " & swCosmosMotionStudyResults.GetPlotCount
Dim plotFeatures() As IFeature
plotFeatures = swCosmosMotionStudyResults.GetPlotFeatures()
Dim featName As String, featType As String
If Not (plotFeatures(0) Is Nothing) Then
Debug.Print "Number of elements in plotFeatures: " & UBound(plotFeatures, 1) - LBound(plotFeatures, 1) + 1
boolstatus = swCosmosMotionStudyResults.ExportCSVFile(plotFeatures(0), "C:\Users\Matt\Desktop\Baja 2019-2020\Programming_For_Design\Trace Path1.csv")
Debug.Print "it worked: " & boolstatus
featType = plotFeatures(0).GetTypeName()
Debug.Print featType
Else
Debug.Print "No plots"
End If
End Sub
SOLVED
I pretty much figured it out with a little workaround, but still, the method achieves all my goals. For some reason, only actual plots that have X-values and Y-Values can be used in the ExportCSVFile(...) function. Thus to achieve a CVS file with the wheel trace path. I added three linear displacement result plots to the same plot (Plot6). The full file path is needed including the new file name. This macro can run even with the plots hidden, thus can be used iteratively in my new genetic algorithm.
Sub main()
Debug.Print String(255, vbNewLine)
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swMotionMgr As SwMotionStudy.MotionStudyManager
Dim swMotionStudy1 As SwMotionStudy.MotionStudy
Dim swResults As SwMotionStudy.MotionStudyResults
Dim swMotionStudyProps As SwMotionStudy.MotionStudyProperties
Dim swCosmosMotionStudyProps As SwMotionStudy.CosmosMotionStudyProperties
Dim swCosmosMotionStudyResults As ICosmosMotionStudyResults
Dim boolstatus As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swMotionMgr = swModelDocExt.GetMotionStudyManager()
If (swMotionMgr Is Nothing) Then
End
End If
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
Set swMotionStudy1 = swMotionMgr.GetMotionStudy("PhysSim")
If (swMotionStudy1 Is Nothing) Then
MsgBox "PhysSim is not available."
End
End If
swMotionStudy1.StudyType = 4
If Not swMotionStudy1.IsActive Then swMotionStudy1.Activate
Set swMotionStudyProps = swMotionStudy1.GetProperties(4)
Set swCosmosMotionStudyProps = swMotionStudyProps
Set swCosmosMotionStudyResults = swMotionStudy1.GetResults(4)
Call swMotionStudy1.Calculate
Dim numPlots As Integer
numPlots = swCosmosMotionStudyResults.GetPlotCount
Debug.Print " Number of plots: " & swCosmosMotionStudyResults.GetPlotCount
Dim plotFeatures() As IMotionPlotFeatureData
plotFeatures = swCosmosMotionStudyResults.GetPlotFeatures()
featType = plotFeatures(2).GetTypeName()
Debug.Print featType
'PLOT FEATURE MUST BE AN ACTUAL PLOT, EXPORTING TRACE PATHS DID NOT WORK ==> Angular Displacement, Linear Displacement, and Etc can work
boolstatus = swCosmosMotionStudyResults.ExportCSVFile(plotFeatures(4), "C:\Users\Matt\Desktop\Baja 2019-2020\Rear Suspension\Anything.csv")
Debug.Print "it worked: " & boolstatus
End Sub