要在Solidworks中讲话的VBA宏

时间:2015-08-10 23:14:35

标签: vba solidworks

我的宏已完成任务后,我的消息框中会弹出超过100个引号的随机引号生成器。我可以让宏说出消息框中的消息吗?

我有一个宏我的前同事写过使用VBA在excel中执行此操作,但我无法在solidworks中使用它。

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swCustProp As CustomPropertyManager
Dim swView As SldWorks.View

Dim ConfigName As String
Dim i As Long
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim PartNo As String
Dim nFileName As String
Dim swDocs As Variant
Dim PDFpath As String
Dim currpath As String
Dim PartNoDes As String
Dim strquotes(9) As String
Dim lngIndex As Long

Sub main()

strquotes(1) = "Charge like a wounded bull."
strquotes(2) = "Colder than a coal miner's bum."
strquotes(3) = "Tighter than a fish's asshole, and that's watertight."
strquotes(4) = "Is the pope catholic?"
strquotes(5) = "FINE = fucking insecure neurotic and emotional."
strquotes(6) = "I think that's a boy on a man's mission."
strquotes(7) = "Don't stick your finger where you wouldn't stick your dick."
strquotes(8) = "After all's said and done there's more said than done."
strquotes(9) = "Stick to it like shit on a wool blanket."

lngIndex = Int((9 - 0 + 1) * Rnd + 0)

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

If swModel.GetType = swDocDRAWING Then

Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Set swModel = swView.ReferencedDocument

currpath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
PDFpath = currpath & "PDF"

If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath


            If swModel.GetType = swDocPART Then
                    PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
                    PartNoDes = Right(PartNoDes, Len(PartNoDes) - 14)
                    PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
                    PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
                    PartNo = Left(PartNo, Len(PartNo) - 7)
                    Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
                    ConfigName = swView.ReferencedConfiguration
                    swCustProp.Get2 "Description", valOut1, resolvedValOut1
                    swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                    nFileName = PDFpath & "\" & PartNo & "-" & ConfigName & "-" & resolvedValOut2 & " " & PartNoDes
                    swDraw.SaveAs3 nFileName & ".PDF", 0, 0
                    Application.speech.speak (strquotes(lngIndex))
                    MsgBox (PartNo & "-" & ConfigName & "-" & resolvedValOut2 & " " & PartNoDes & ".pdf" & "  Saved in" & vbNewLine & Left(swModel.GetPathName, Len(swModel.GetPathName) - 17) & "PDF" & vbNewLine & vbNewLine & "Lormanism Of The Day :" & vbNewLine & strquotes(lngIndex))

            ElseIf swModel.GetType = swDocASSEMBLY Then
                    PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
                    PartNoDes = Right(PartNoDes, Len(PartNoDes) - 11)
                    PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
                    PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
                    PartNo = Left(PartNo, Len(PartNo) - 7)
                    Set swCustProp = swModel.Extension.CustomPropertyManager("")
                    swCustProp.Get2 "Description", valOut1, resolvedValOut1
                    swCustProp.Get2 "Revision", valOut2, resolvedValOut2
                    nFileName = PDFpath & "\" & PartNo & "-" & resolvedValOut2 & " " & PartNoDes
                    swDraw.SaveAs3 nFileName & ".PDF", 0, 0
                    Application.speech.speak (strquotes(lngIndex))
                    MsgBox (PartNo & "-" & resolvedValOut2 & " " & PartNoDes & ".pdf" & "  Saved in" & vbNewLine & Left(swModel.GetPathName, Len(swModel.GetPathName) - 17) & "PDF" & vbNewLine & vbNewLine & "Lormanism Of The Day :" & vbNewLine & strquotes(lngIndex))
            End If

Set swDraw = Nothing

Else: MsgBox "Active document is not a drawing"

End If

End Sub

我正在查看application.speech.speak (strquotes(lngIndex))行,我收到以下错误:Run-time error '438': Object doesnt support this property or method

1 个答案:

答案 0 :(得分:1)

您可以尝试此操作,当计算机说出文本时返回True。

Function RobotSpeaking(sText As String) As Boolean
    On Error Resume Next
    Err.Clear
    With CreateObject("SAPI.SpVoice")
        .Volume = 100
        .Speak sText
    End With
    RobotSpeaking = (Err.Number = 0)
End Function