8 Replies Latest reply on May 30, 2016 9:39 AM by Arthur McRae

    Userform auto close

    Arthur McRae

      Working on a Macro that has several Userforms.

      I can find how to have an auto closing Userform for excel but it isn't working for soldiworks.

      I'm finding code like this:

      Sub show_UserForm()

      Application.OnTime Now + TimeValue("00:00:15"), "close_UserForm"

      UserForm1.Show

      End Sub

       

      Sub close_UserForm()

      Unload UserForm1

      End Sub

      Or:

      Private Sub UserForm_Activate()

        Application.Wait = (Now + TimeValue("0:00:30"))

        Sheet1.Cells(1, 1) = "Yes"

        Unload Me

      End Sub

      But I can't get it to run with solidworks Macros

        • Re: Userform auto close
          Deepak Gupta

          Try these

          UserForm1.hide

          Unload UserForm1

          • Re: Userform auto close
            Arthur McRae

            I've been in contact with API support. The userform timer functionality i was looking for, while available in excel and ms word, is not included in the SW libaray.  Their response was this:

            What we need is a timer event based library for VBA

             

            Once the timer event functionality is available then we need to also need keyboard and mouse event handling.

             

            Here is general algorithm

            1] when  form is displayed, start timers 2] in mouse and keyboard events reset timer 3] on timer end close form

             

            Currently the timer functionality  is not available.

            So basically not possible.

              • Re: Userform auto close
                Arthur McRae

                Our company has a foler heirarchy of where files are supposed to go, Model file, DXF file, BOM file etc.

                So everytime I save a PDF I have to traverse the heiarachy to the "Published" folder, this macro saves the drawing out as a PDF in the correct file for me.

                Option Explicit

                Dim swApp           As SldWorks.SldWorks

                Dim swDoc           As SldWorks.ModelDoc2

                Dim swModelDocExt   As SldWorks.ModelDocExtension

                Dim swCustProp      As CustomPropertyManager

                 

                 

                Dim boolstatus      As Boolean

                Dim longstatus      As Long, longwarnings As Long

                Dim Prop_N()        As String

                Dim iReply          As String

                Dim saveDir         As String, FileDir As String, FileName As String, sRev As String, sP_Numb As String, sStatus As String

                Dim FileExt(1 To 2) As String

                Dim FileChk         As Boolean

                 

                 

                 

                 

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

                Sub main()

                 

                 

                Set swApp = Application.SldWorks

                Set swDoc = swApp.ActiveDoc

                'check that a File is open

                If swDoc Is Nothing Then

                iReply = "No File open"

                MsgBox iReply

                End

                End If

                Set swModelDocExt = swDoc.Extension

                Set swCustProp = swModelDocExt.CustomPropertyManager("")

                '

                Prop_N() = Split("Status, PROJECT NO, Revision, CheckedBy, Description", ", ")

                '

                'iReply = "WARNING! Macro underdevelopment"

                'MsgBox iReply

                 

                 

                'Checks to make sure current file is a drawing

                If swDoc.GetType <> swDocDRAWING Then

                MsgBox "Warning, File not Drawing!"

                sRev = 1

                Else

                Dim I As Integer

                Dim val As String, valout As String

                For I = 0 To UBound(Prop_N)

                boolstatus = swCustProp.Get4(Prop_N(I), False, val, valout)

                'Debug.Print "Value:                    " & val

                'Debug.Print "Evaluated value:          " & valout

                'Debug.Print "Up-to-date data:          " & boolstatus

                Select Case I

                        Case 0

                        sStatus = valout

                        Case 1

                        sP_Numb = valout

                        Case 2

                        sRev = valout

                        Case 3

                        If valout <> " " Or valout <> "" Then

                        Debug.Print "Checked by:                " & valout

                        FileChk = True

                        Else

                        FileChk = False

                        End If

                        Case 4

                        Debug.Print "Description:               " & valout

                        Case Else

                        MsgBox "Unrecognized Property"

                End Select

                Next I

                End If

                'set up file extensions

                FileExt(1) = ".pdf"

                FileExt(2) = ".edrw"

                'Gets current file name and path

                FileName = swDoc.GetPathName

                Debug.Print FileName

                'strips solidworks extension off name and replaces with pdf

                FileDir = Left(FileName, Len(FileName) - 7)

                If InStr(FileDir, "Model") = 0 Then

                saveDir = Left(FileDir, InStrRev(FileDir, "\"))

                Else: saveDir = Left(FileDir, InStr(FileDir, "Model") + 5) & "\Published\"

                End If

                FileName = Right(FileDir, Len(FileDir) - InStrRev(FileDir, "\"))

                 

                 

                'Revison format

                If sRev = CStr("1") Or sRev = "" Then

                sRev = ""

                Else

                sRev = "_R" & sRev

                End If

                 

                 

                'Project Number Format

                sP_Numb = Mid(sP_Numb, 2, 5)

                If IsNumeric(sP_Numb) = True Then

                sP_Numb = "P" & sP_Numb

                    If InStr(FileName, sP_Numb) = 0 Then

                    FileName = sP_Numb & "_" & FileName

                    End If

                Else

                sP_Numb = ""

                End If

                 

                 

                'save loop

                For I = 1 To 2

                ' File checked Msg

                If sStatus = "FOR FAB" And FileChk <> True Then

                MsgBox "File not checked."

                End If

                 

                 

                boolstatus = FileSave(saveDir, FileName, sRev, FileExt(I))

                If sStatus <> "FOR FAB" Then

                Exit For

                End If

                Next I

                 

                 

                End Sub

                 

                 

                 

                 

                Function FileSave(DIR As String, NAME As String, REV As String, EXT As String)

                Application.SldWorks.ActiveDoc.Extension.SaveAs DIR & NAME & REV & EXT, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, longstatus, longwarnings

                'Debug.Print "Error: " & longstatus & vbNewLine & "Warning: " & longwarnings

                End Function

                • Re: Userform auto close
                  Deepak Gupta

                  Do you need the timer for closing the userform only?

                   

                  Have you tried the SLEEP function?