79525660

Date: 2025-03-21 13:57:22
Score: 1.5
Natty:
Report link

I know it is a year old, but I did more or less what you asked.
Only now I want to get the active plot name to put it in the filename, but I cannot get this to work.
But the rest of the code might be beneficial for you too.
If you create a few 'saved views' this macro will loop through those and save a PNG for each view to an export folder. This way if you sort this folder on name you can click back and forth to see what changed between runs. It also allows you to add a descriptive suffix to the image filenames.

Option Explicit

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim COSMOSWORKS     As CosmosWorksLib.COSMOSWORKS
Dim CWAddinCallBack As CosmosWorksLib.CWAddinCallBack
Dim ActDoc          As CosmosWorksLib.CWModelDoc
Dim StudyMngr       As CosmosWorksLib.CWStudyManager
Dim Study           As CosmosWorksLib.CWStudy
Dim activeStudyIndex As Integer
'Dim CWResult        As ICWResults
'Dim plot            As CWPlot
'Dim PlotNames       As Variant
'Dim PlotCount       As Long
'Dim PlotName        As String
Dim vViews          As Variant
Dim viewCount       As Long
Dim ViewName        As String
Dim OutputFolder    As String
Dim SubFolder       As String
Dim ImagePath       As String
Dim ImageName       As String
Dim ModelPath       As String
Dim FileName        As String
Dim StudyName       As String
Dim Suffix          As String
Dim i               As Integer
Dim boolstatus      As Boolean
Dim longstatus      As Long, longwarnings As Long

Sub main()
    Debug.Print "---------------" & Now() & "----------------"
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    'Set settings for png export
    boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swTiffScreenOrPrintCapture, 0)

    'Get model location and FileName
    ModelPath = swModel.GetPathName
    FileName = Left(Mid(ModelPath, InStrRev(ModelPath, "\") + 1), InStrRev(Mid(ModelPath, InStrRev(ModelPath, "\") + 1), ".") - 1)
    Debug.Print "FileName: " + FileName

    'Set image location
    OutputFolder = "C:\SW-Simulations"
    SubFolder = FileName
    
    'Create folder if it doesn't exist
    CreateFolder OutputFolder
    CreateFolder OutputFolder & "\" & SubFolder
    ImagePath = OutputFolder & "\" & SubFolder & "\"
    
    'Gather named views
    vViews = swModel.GetModelViewNames

    ''Print vViews
        'For viewCount = LBound(vViews) To UBound(vViews)
        '        Debug.Print viewCount & ": " & vViews(viewCount)
        'Next viewCount
    
    'Add-in callback
    Set CWAddinCallBack = swApp.GetAddInObject("SldWorks.Simulation")
    Set COSMOSWORKS = CWAddinCallBack.COSMOSWORKS

    'Get active document
    Set ActDoc = COSMOSWORKS.ActiveDoc()

    'Get the active study
    Set StudyMngr = ActDoc.StudyManager()
    activeStudyIndex = StudyMngr.ActiveStudy

    Set Study = StudyMngr.GetStudy(activeStudyIndex)
    StudyName = Study.Name
    Debug.Print "StudyName: " & StudyName
    
'   Try out to get the plot names to loop through and to put the plot name in the filename
'    CWResult = Study.results
'    PlotNames = CWResult.GetPlotNames()
'
'    For PlotCount = LBound(PlotNames) To UBound(PlotNames)
'        PlotName = PlotNames(PlotCount)
'        Debug.Print PlotName
'    Next PlotCount

    'Ask  user to add suffix to image filename
    Suffix = InputBox("The filename of the snapshots will get the following name:" _
        & vbNewLine & StudyName + " - [ViewName] - [time yy-mm-dd_hh mm ss]" _
        & vbNewLine & "" _
        & vbNewLine & "You can add a more specific description if you like:" _
        , "Add suffix to snapshot name", "", vbOKOnly)
    Debug.Print Suffix
    Suffix = " - " & Suffix
    
    i = 0
    'Loop through views and save PNGs
    For viewCount = LBound(vViews) To UBound(vViews)
        ViewName = vViews(viewCount)

        If InStr(ViewName, "*") > 0 Then
            'Skip standard views (contains "*")
            'Debug.Print "Standard view: skipped"
        Else
            'Process named views
            i = i + 1
            Debug.Print ""
            Debug.Print i & " View name: " & ViewName
            'Compile imagename
            ImageName = StudyName + " - " + ViewName + " - " + Format(Now, "yy-mm-dd_hh mm ss") & Suffix
            Debug.Print "Image name: " + ImageName

            'Activate view
            swModel.ShowNamedView2 ViewName, -1
            
            'Save as PNG
            longstatus = swModel.SaveAs3(ImagePath + ImageName + ".PNG", 0, 2)
            Debug.Print "SaveStatus: " & longstatus
        End If
    Next viewCount
    
    'If no views are available, inform  user and save current view
    If i = 0 Then
        MsgBox "There are no saved views to export as PNG." _
        & vbNewLine & "First create some views:" _
        & vbNewLine & "1. Orient and zoom your model to the desired view." _
        & vbNewLine & "2. Press spacebar" & vbNewLine & "3. Click 'New view'" _
        & vbNewLine & "4. Give it a recognizable name" _
        & vbNewLine & "" _
        & vbNewLine & "Now the current view will be saved as PNG.", _
        vbExclamation, "No views to process"
        
        'Compile imagename
        ImageName = StudyName + " - current view - " + Format(Now, "yy-mm-dd_hh mm ss") & Suffix
        Debug.Print "Image name: " + ImageName
        
        'Save as PNG
        longstatus = swModel.SaveAs3(ImagePath + ImageName + ".PNG", 0, 2)
        
        Debug.Print "No saved views, current view is saved."
    Else
        Debug.Print ""
        Debug.Print i & " views saved as PNG"
    End If
    
    'Open output folder
    'Shell "explorer.exe " & ImagePath, vbNormalFocus
End Sub

Sub CreateFolder(FolderPath As String)
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
        Debug.Print "New folder created: " & Replace(FolderPath, "\\ms1\CompanyData", "K:")
    Else
        Debug.Print "Folder already exists: " & Replace(FolderPath, "\\ms1\CompanyData", "K:")
    End If
End Sub
Reasons:
  • Blacklisted phrase (0.5): I cannot
  • RegEx Blacklisted phrase (1): I want
  • Long answer (-1):
  • Has code block (-0.5):
  • Unregistered user (0.5):
  • Low reputation (1):
Posted by: Erik