Here ya go. In Acad, type VBAMAN; create a new file; Save As Acad.dvb; go to the VBA Editor; double click on ThisDrawing in thye tree view to the left; pasre this code into the code window for ThisDrawing:
'''Subs by Mark Propst, posted to the autodesk VBA newsgroup
'''June 23, 2003
Option Explicit
Dim kb As clsKeyboard
Dim command_count As Long
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Select Case UCase(CommandName)
Case UCase("mtext"), UCase("text"), UCase("mtedit"), UCase("dtext"), _
UCase("ddedit"), UCase("ddatte"), UCase("QLEADER"), UCase("Layer")
'add whatever other commands you may want CapsOn for, both here and the EndCommand event.
Set kb = New clsKeyboard
kb.CapsOn = True
Case Else
If Not kb Is Nothing Then
kb.CapsOn = False
Set kb = Nothing
End If
End Select
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case UCase("mtext"), UCase("text"), UCase("mtedit"), UCase("dtext"), _
UCase("ddedit"), UCase("ddatte"), UCase("QLEADER"), UCase("Layer")
kb.CapsOn = False
If Not kb Is Nothing Then
Set kb = Nothing
End If
End Select
Now, go to the Insert menu, select Class Module; right click the new Class it creates and rename to clsKeyboard; double click to open the code window for it; add this code to the class:
Option Explicit
'''Functions by Bobby C. Jones of AcadX.com
Private Const VK_CAPITAL = &H14
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Type OSVERSIONINFO
dwOSVerInfoSize As Long
dwMajorVer As Long
dwMinorVer As Long
dwBuildNumber As Long
dwPlatformID As Long
szCSDVer As String * 128
End Type
Private Declare Function GetVersionEX Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" (keys As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (keys As KeyboardBytes) As Long
Private keys As KeyboardBytes
'* * * * * * * * * * * * *
'Public Members
'* * * * * * * * * * * * *
Public Property Get CapsOn() As Boolean
CapsOn = GetKeyStatus(VK_CAPITAL)
End Property
Public Property Let CapsOn(ByVal bValue As Boolean)
setKey VK_CAPITAL, bValue
End Property
Public Property Get NumLockOn() As Boolean
NumLockOn = GetKeyStatus(VK_NUMLOCK)
End Property
Public Property Let NumLockOn(ByVal bValue As Boolean)
setKey VK_NUMLOCK, bValue
End Property
Public Property Get ScrollOn() As Boolean
ScrollOn = GetKeyStatus(VK_SCROLL)
End Property
Public Property Let ScrollOn(ByVal bValue As Boolean)
setKey VK_SCROLL, bValue
End Property
'* * * * * * * * * * * * *
'Private functions
'* * * * * * * * * * * * *
Private Sub setKey(vkKey As Long, onVal As Boolean)
Dim OS As OSVERSIONINFO
Dim keyState As Boolean
'get OS info
OS.dwOSVerInfoSize = Len(OS)
GetVersionEX OS
'Get the keyboard state
GetKeyboardState keys
'Get the key state
keyState = keys.kbByte(vkKey)
'Change a key
If keyState <> onVal Then
If OS.dwPlatformID = VER_PLATFORM_WIN32_NT Then
'simulate key press
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
'simulate key release
keybd_event vkKey, &H45, KEYEVENTF_EXTENDEDKEY Or _
KEYEVENTF_KEYUP, 0
Else
keys.kbByte(vkKey) = Abs(onVal)
SetKeyboardState keys
End If
End If
End Sub
Private Function GetKeyStatus(vkKey As Long) As Boolean
'get the keyboard state
GetKeyboardState keys
'get and return the key state
GetKeyStatus = keys.kbByte(vkKey)
End Function
If you need help making Acad autoload the acad.dvb, refer to the help docs. The process is slightly different for different versions.
