Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports System
Imports System.Windows.Forms
Namespace LispKeys
#Region "myFunctions"
Public Class MyFunctions
Implements IExtensionApplication
Public Sub Initialize() Implements IExtensionApplication.Initialize
Autodesk.AutoCAD.ApplicationServices.Application. _
DocumentManager.MdiActiveDocument.Editor.WriteMessage(
vbLf & "LispKeys Loaded. " & vbLf
)
End Sub
Public Sub Terminate() Implements IExtensionApplication.Terminate
' Do plug-in application clean up here
End Sub
Private Shared ed As Editor = Autodesk.AutoCAD.ApplicationServices. _
Application.DocumentManager.MdiActiveDocument.Editor
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Integer, _
ByVal dwExtraInfo As Integer)
#Region "CapsLock"
Shared Sub ToggleCapsLock()
keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 1, 0)
keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 3, 0)
End Sub
<LispFunction("CapsLock")> _
Public Function CapsLock(ByVal args As ResultBuffer)
Try
If args Is Nothing Then
If My.Computer.Keyboard.CapsLock = True Then
Return True
Else
Return Nothing
End If
End If
Dim myArgs As Array = args.AsArray
If myArgs.Length > 1 Then
Throw New TooManyArgsException()
End If
Dim arg As TypeCode = myArgs(0).Typecode
If arg = LispDataType.T_atom Then
If My.Computer.Keyboard.CapsLock <> True Then
ToggleCapsLock()
End If
Return True
End If
If arg = LispDataType.Nil Then
If My.Computer.Keyboard.CapsLock <> False Then
ToggleCapsLock()
End If
Return Nothing
End If
Throw New ArgumentTypeException("atom", myArgs(0))
Return Nothing
Catch ex As LispException
ed.WriteMessage(vbLf & "LISP error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf & "AutoCAD error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As System.Exception
ed.WriteMessage(vbLf & "System error: {0}" & vbLf, ex.Message)
Return Nothing
End Try
End Function
#Region "NumLock"
Shared Sub ToggleNumLock()
keybd_event(System.Windows.Forms.Keys.NumLock, &H90, 1, 0)
keybd_event(System.Windows.Forms.Keys.NumLock, &H90, 3, 0)
End Sub
<LispFunction("NumLock")> _
Public Function NumLock(ByVal args As ResultBuffer)
Try
If args Is Nothing Then
If My.Computer.Keyboard.NumLock = True Then
Return True
Else
Return Nothing
End If
End If
Dim myArgs As Array = args.AsArray
If myArgs.Length > 1 Then
Throw New TooManyArgsException()
End If
Dim arg As TypeCode = myArgs(0).Typecode
If arg = LispDataType.T_atom Then
If My.Computer.Keyboard.NumLock <> True Then
ToggleNumLock()
End If
Return True
End If
If arg = LispDataType.Nil Then
If My.Computer.Keyboard.NumLock <> False Then
ToggleNumLock()
End If
Return Nothing
End If
Throw New ArgumentTypeException("atom", myArgs(0))
Return Nothing
Catch ex As LispException
ed.WriteMessage(vbLf & "LISP error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf & "AutoCAD error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As System.Exception
ed.WriteMessage(vbLf & "System error: {0}" & vbLf, ex.Message)
Return Nothing
End Try
End Function
#Region "ScrollLock"
Shared Sub ToggleScrollLock()
keybd_event(System.Windows.Forms.Keys.Scroll, &H91, 1, 0)
keybd_event(System.Windows.Forms.Keys.Scroll, &H91, 3, 0)
End Sub
<LispFunction("ScrollLock")> _
Public Function ScrollLock(ByVal args As ResultBuffer)
Try
If args Is Nothing Then
If My.Computer.Keyboard.ScrollLock = True Then
Return True
Else
Return Nothing
End If
End If
Dim myArgs As Array = args.AsArray
If myArgs.Length > 1 Then
Throw New TooManyArgsException()
End If
Dim arg As TypeCode = myArgs(0).Typecode
If arg = LispDataType.T_atom Then
If My.Computer.Keyboard.ScrollLock <> True Then
ToggleScrollLock()
End If
Return True
End If
If arg = LispDataType.Nil Then
If My.Computer.Keyboard.ScrollLock <> False Then
ToggleScrollLock()
End If
Return Nothing
End If
Throw New ArgumentTypeException("atom", myArgs(0))
Return Nothing
Catch ex As LispException
ed.WriteMessage(vbLf & "LISP error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf & "AutoCAD error: {0}" & vbLf, ex.Message)
Return Nothing
Catch ex As System.Exception
ed.WriteMessage(vbLf & "System error: {0}" & vbLf, ex.Message)
Return Nothing
End Try
End Function
#Region "VolumeMute"
' More to come
End Class
#Region "myExceptions"
''' <summary>
''' Special thanks to Gile for help with 'LispExceptions'
''' More info here: http://www.theswamp.org/index.php?topic=41509.msg466232#msg466232
''' </summary>
''' <remarks></remarks>
Public Class LispException
Inherits System.Exception
Public Sub New(ByVal msg As String)
MyBase.New(msg)
End Sub
End Class
Public Class TooFewArgsException
Inherits LispException
Public Sub New()
MyBase.New("Too few arguments")
End Sub
End Class
Public Class TooManyArgsException
Inherits LispException
Public Sub New()
MyBase.New("Too many arguments")
End Sub
End Class
Public Class ArgumentTypeException
Inherits LispException
Public Sub New(ByVal s As String, ByVal tv As TypedValue)
MyBase.New(String.Format("Bad argument type: {0} {1}", s,
(tv
.TypeCode = CType(LispDataType
.Nil,
Integer))))
End Sub
End Class
End Namespace
