Excel Games

I’ve been wondering if video games (RPG mainly) could be developed under Excel+VBA. It’s cristal clear that Excel by itself can be turned into a time consuming machine. For this task, simple games were developed by Andrew Engwirda, and even the Excel gurus Chip Pearson and Andy Pope have posts on games. Also, a fun version […]

I’ve been wondering if video games (RPG mainly) could be developed under Excel+VBA.

When open Excel looks like a plain table, nothing that can resemble a dynamic environment. That is a fairly untrue statement. Even from the first MsOffice version, it has embebded easter-eggs full of motion.

Aside from easter-eggs, that are specifically coded inside Office, with a little help of imagination cells, formulas, charts and shapes can be turned into objects that do not behave as static ones.

It’s cristal clear that Excel by itself can be turned into a time consuming machine. For this task, simple games were developed by Andrew Engwirda, and even the Excel gurus Chip Pearson and Andy Pope have posts on games. Also, a fun version of Mine Sweeper can be downloaded at the great https://www.vertex42.com/ExcelArticles/fun-with-excel.html. But it seems these examples had no real intention to be more than table games, like the Sudokus, Chess, Monopoly and a myriad of things like that. Even a more evolved, as The game of life, is kind of obvious to be rightly implemented into Excel, as they are mostly “table formated”. There are a lot of samples of this kind on Keko’s site, on ExcelGame’s site, and on DzikoSoft.

For more complex creations, and one that really have perplexed myself since long time ago, are that from George Lungu’s ExcelUnusual, Excel as pure art. But it also seems difficult to extend this concept for using Excel as a game developing environment.

But the thing we are looking after resembles more to the new mobile games. They, for sure, can be emulated in Excel, for example, Angry Birds, or the short lived FlappyBird one, here in three flavours, Cells scent, throughly explained hereChart scent (not downloadable any more), and Forms scent.

An approximation to the game world via Flash, as depicted in most of the links at https://www.exceltrick.com/interesting/excel-games-free-download/, is not a feasible solution, as has little to do with Excel+VBA, beeing an embedded Flash object (an it’s security implications), and need a javascriptish language to be learned, which is not very VBA look alike.

So, if we want to go further on Excel, things start to get tricky, as usually they are lost on dead sites or are not yet fully developed.

Legendary Colo’s Excel Junk Room maintained a list of Excel games that leaded me to Kouichi Tani’s dead web site, which contains a bunch of games made entirely on Excel (the site is dead, so again archive.org came to the recue).

Looks like japanese people really enjoy “playing” with Excel, as you can see in any of the games linked at http://www1.plala.or.jp/chikada/vba/vba.htm which also has a better looking site http://www.geocities.jp/excel_game/. They are in most cases 2D, but the ideas underneath must be of some value, and can be borrowed for the development.

Newer good approximations to this subject are triyed and described by:

  • C Bel has created an incredible 3D engine (Doom alike) which surely could be improved if some calculations were coded with VBA, but so far is looks like this:

https://www.youtube.com/watch?v=iCeOEQVUWZ0

Finally Excel can be unleash free to get a Legend of Zelda port to Excel. Better to see it with your own eyes to believe it (not 3D, kinda isometric view):

https://www.youtube.com/watch?v=GzC2K-kn31o

(download at http://youtu.be/PL9lz5_W0Bo). The author has also programmed an Space Wars clone, a car driving Out Run clone, and some other games. He also developed some kind of Sprite drawing software, very useful to make great games, which I would recommend to combine with a BMPToExcel macro to get sprites done in a bliss.
All can be downloaded from his 4Shared account, starting from his Excelda! (https://www.4shared.com/office/_LGiDKRt/Excelda_v013.html). They have a big issue with API functions (Sleep and GetAsyncKeyState, that make the games ultraslow, even with modern computers -although I’m using Office2k7 which it not a good platform for these kind of graphic developments-).

These last five items are the more promissing ones, but they seem not to rely on Excel.Shapes (GamesExcel ones does), and that thing is annoying me a bit. I believe better looking games with “decent” frame rate can be achieved with Excel.Shapes… so should be tried.

It should be worth to check ExcelSimulators site, as they have triyed several options to get the job done with shapes and also Priyenda Kumar’s site in his series for the game of the Bowman.

Excel as a Game Engine Motor

Following is my intro into the “game business”…

Lets throw some code into the VBA editor. Open the code module of a worksheet, put code PlayScreen inside.

Code PlayScreen:

Option Explicit

'Move After Return Direction
Dim OldMARD As Excel.XlDirection 'Global
Dim NewMARD As Excel.XlDirection 'Global

Private Sub WorkSheet_Activate()
    Call fSetPlayScreen(ActiveSheet, OldMARD, NewMARD)
End Sub

Private Sub WorkSheet_Deactivate()
    Call fRestorePlayScreen(OldMARD)
End Sub

This procedures will trigger any time Worksheet get activated/desactivated, and their purpose is setting whole Columnwidth and Rowheight in order to achieve movements.
Also, some key events are captured and assigned to game events, “{LEFT}”, “{RIGHT}”, “{UP}”, “{DOWN}” for obvious reasons, “f” (as there is no {SPACE} chance no recalling to GetAsyncKeyState) can be assigned to fire of any ammo the character has in its bag, and even some combinations like “+{UP}” can be used to jump or “+{DOWN}” to crawl, “+{RIGHT} to run faster,…

For achieving this, paste the following code in a module:

Option Explicit

Const BulletSize As Single = 1

Public Function fBuildCaller(ByVal bWorkbookName As Boolean, _
                             ByVal ProcName As String, _
                             ParamArray Args() As Variant) As Variant
' Function to build procedure with variable number of arguments
' Take care that if bWorkBookName = True, will be permanent linked to the Workbook
    Dim oItem As Variant
    Dim oSubItem As Variant
    Dim strDebug As String
    Dim lgRetVal As Long

    For Each oItem In Args
        If IsArray(oItem) Then
            For Each oSubItem In oItem
                strDebug = strDebug & " """ & oSubItem & ""","
            Next oSubItem
        Else
            strDebug = strDebug & " """ & oItem & ""","
        End If
    Next oItem

    If bWorkbookName Then
        lgRetVal = VBA.MsgBox("If bWorkbookName is set to True, will be permanently linked to Workbook, go with it?", _
                              vbYesNo + vbExclamation, "I N F O")
        If lgRetVal = vbNo Then bWorkbookName = False
    End If
    If strDebug = vbNullString Then
        strDebug = VBA.IIf(bWorkbookName, "'" & ThisWorkbook.Name & "'!", "") & _
                   "'" & ProcName & "'"
    Else
        strDebug = VBA.IIf(bWorkbookName, "'" & ThisWorkbook.Name & "'!", "") & _
                   "'" & ProcName & VBA.Mid$(strDebug, 1, Len(strDebug) - 1) & "'"
    End If
    fBuildCaller = strDebug
End Function

Public Function fBuildCaller2(ByVal ProcName As String, _
                              ParamArray Args() As Variant) As Variant
' Only working for PopUpMenus... better use fBuildCaller
' Has the advantage that "OnAction" is not linked to the WorkBook name
    Dim oItem As Variant
    Dim strDebug As String

    For Each oItem In Args
        strDebug = strDebug & Chr(34) & oItem + Chr(34) & ","
    Next

    If strDebug = vbNullString Then
        strDebug = ProcName
    Else
        strDebug = ProcName & "(" & VBA.Mid$(strDebug, 1, Len(strDebug) - 1) & ")"
    End If
    fBuildCaller2 = strDebug
End Function

Public Function fWalk(ByVal oDirection As Excel.XlDirection, _
                      Optional ByVal bFast As Boolean = False)
    Dim oWsh As Excel.Worksheet
    Dim sgSpeed As Single

    Set oWsh = ActiveSheet
    sgSpeed = oWsh.Cells(1, 1).Column.Width

    'Application.ScreenUpdating = False
    With ActiveWindow
        If bFast Then
            Select Case oDirection
                Case Is = xlToLeft
                    '.LargeScroll ToRight:=-1
                    oWsh.Shapes("Body").IncrementLeft -(2 * sgSpeed)
                Case Is = xlDown:
                    '.LargeScroll Down:=-1
                    oWsh.Shapes("Body").IncrementTop -(2 * sgSpeed)
                Case Is = xlToRight
                    '.LargeScroll ToRight:=1
                    oWsh.Shapes("Body").IncrementLeft (2 * sgSpeed)
                Case Is = xlUp
                    '.LargeScroll Down:=1
                    oWsh.Shapes("Body").IncrementTop (2 * sgSpeed)
            End Select
        Else
            Select Case oDirection
                Case Is = xlToLeft
                    .SmallScroll ToRight:=-1
                    oWsh.Shapes("Body").IncrementLeft -(1 * sgSpeed)
                Case Is = xlDown
                    '.SmallScroll Down:=-1
                    oWsh.Shapes("Body").IncrementTop -(1 * sgSpeed)
                Case Is = xlToRight
                    .SmallScroll ToRight:=1
                    oWsh.Shapes("Body").IncrementLeft (1 * sgSpeed)
                Case Is = xlUp
                    '.SmallScroll Down:=1
                    oWsh.Shapes("Body").IncrementTop (1 * sgSpeed)
            End Select
        End If
        '.LargeScroll ToRight:=-1
        '.LargeScroll Down:=1
    End With
    'Application.ScreenUpdating = True
End Function

Public Function fSetPlayScreen(ByVal oWsh As Excel.Worksheet, _
                               ByRef OldMARD As Excel.XlDirection, _
                               Optional ByRef NewMARD As Excel.XlDirection = xlDown)
    Dim oCells As Excel.Range
    Dim BulletSize As Single

    ' Set zoom
    ActiveWindow.Zoom = 70
    With oWsh
        Set oCells = .Cells
        oCells.RowHeight = 15
        oCells.ColumnWidth = 2.14
        Set oCells = Nothing
    End With

    With Application
        Call set_MARD(NewMARD, OldMARD)
        'MARD = Application.MoveAfterReturnDirection
        '.MoveAfterReturnDirection = xlToLeft 'xlToRight

        'Restore OnKey Events
        .OnKey "{LEFT}", fBuildCaller(False, "fWalk", xlToLeft)
        .OnKey "{RIGHT}", fBuildCaller(False, "fWalk", xlToRight)
        .OnKey "{DOWN}", fBuildCaller(False, "fWalk", xlUp)
        .OnKey "{UP}", fBuildCaller(False, "fWalk", xlDown)

        .OnKey "f", fBuildCaller(False, "fFire", BulletSize)
        .OnKey "g", fBuildCaller(False, "fGetObject")
        .OnKey "a", fBuildCaller(False, "fAmmo")
        .OnKey "d", fBuildCaller(False, "fDestroy")

        .OnKey "+{LEFT}", fBuildCaller(False, "fWalk", xlToLeft, "True")
        .OnKey "+{RIGHT}", fBuildCaller(False, "fWalk", xlToRight, "True")
        .OnKey "+{DOWN}", fBuildCaller(False, "fCrawl")
        .OnKey "+{UP}", fBuildCaller(False, "fJump")
    End With
End Function

Public Function fJump()
' Make the character jump to gather a platform or to avoid an enemy
End Function
Public Function fCrawl()
' Make the character crawl to gather some tight space, or to avoid high enemy attack
End Function
Public Function fGetObject()
' Make the character get any object
End Function
Public Function fFire(ByVal BulletSize As Single)
' Generate a bullet that moves BulletSize
End Function
Public Function fAmmo()
' Let the character get any ammo it has... can be implemented as a roulette... next ammo, next ammo,...
End Function
Public Function fDestroy()
' Let the character destroy any object in front of him
End Function

'Public Sub sRestorePlayScreen()
'    Call fRestorePlayScreen
'End Sub

Public Function fRestorePlayScreen(Optional ByRef OldMARD As Excel.XlDirection = xlDown)
    With Application
        Call restore_MARD(OldMARD)
        '.MoveAfterReturnDirection = MARD

        'Restore OnKey Events
        .OnKey "{LEFT}"
        .OnKey "{RIGHT}"
        .OnKey "{DOWN}"
        .OnKey "{UP}"

        .OnKey "+{LEFT}"
        .OnKey "+{RIGHT}"
        .OnKey "+{DOWN}"
        .OnKey "+{UP}"
    End With
End Function

Public Sub set_MARD(ByRef OldMARD As Excel.XlDirection, _
                    Optional ByRef NewMARD As Excel.XlDirection = xlDown)
    OldMARD = Application.MoveAfterReturnDirection
    Application.MoveAfterReturnDirection = NewMARD 'xlDown, xlUP, xlToLeft, xlToRight
End Sub

Public Sub restore_MARD(Optional ByRef OldMARD As Excel.XlDirection = xlDown)
    Application.MoveAfterReturnDirection = OldMARD
End Sub

In the worksheet, we need a character, named “Body” in this sample that must exists on the worksheet, this should be a shape (of any kind). So insert one to keep things moving.

From here on, we need a label in order to show score and other information (like number of lifes, health status, ammo,…). Lets call this shape “Info”.

We can add a physical green ground, and some deep background with clouds or sunny sky.

There can be enemies of different kinds, and for these we need a collision detection procedure (that will be implemented soon and posted here).

This could be a simple RPG game engine. Possibilities are endless.

An Excel CAD (xlCAD)

Excel has enough capabilities to be used as a poor man’s CAD application, not recalling to Windows API to do it (at least not the ones used to draw), which IMHO would be the best way to accomplish full CAD features but could take longer to get working as a whole. Full DXF, SHP, KML,… I/O operations can be done inside the Excel CAD.

A good first reference of what can be done with Excel is this guide.

First, we need to know which are the shapes that we will deal with. So lets draw them in an Excel Worksheet to take a look in their geometry. To do so, we use a VBA macro to generate them, from information in Mso online help.

If we paste the Mso help table in a Worksheet, order them by msoAutoShapeType, we can therun the following VBA code to make the shapes appear (also will show the number of adjustments it has, and the numeration of the connecting sites if desired).

[sourcecode language=”vb”]
Public Sub sShapes_Template()
‘https://msdn.microsoft.com/en-us/vba/office-shared-vba/articles/msoautoshapetype-enumeration-office
‘ConnectionSites are generally distributed from 1=90º in counter clockwise order (from 109 to 136 in clockwise order, and 1=0º)
Dim oCell As Excel.Range
Dim oShpGroup As Excel.Shape
Dim oShp As Excel.Shape
Dim oShpCtr As Excel.Shape
Dim oShpConnector As Excel.Shape
‘Dim oAdjustment As Excel.Adjustments
Dim msoAutoshapeTypeValue As Long
Dim sgHeight As Single
Dim sgWidth As Single
Dim sgLeft As Single
Dim sgTop As Single
Dim lgAdjustment As Long
Dim lgConnector As Long

Const TOP_SIDE As Integer = 1
Const LEFT_SIDE As Integer = 2
Const BOTTOM_SIDE As Integer = 3
Const RIGHT_SIDE As Integer = 4

With ActiveSheet
.Rows(“2:185”).RowHeight = 72
For Each oCell In .Columns(1).SpecialCells(xlCellTypeConstants).Cells
If oCell.Row >= 3 Then
msoAutoshapeTypeValue = oCell.Offset(0, 1).Value
sgHeight = oCell.Height – 10
sgWidth = sgHeight

On Error GoTo NextShp
Set oShp = .Shapes.AddShape(Type:=msoAutoshapeTypeValue, _
Left:=oCell.Left + (2 * sgWidth), _
Top:=oCell.Top + 5, _
Width:=sgWidth, _
Height:=sgHeight)
‘Set new Group
Set oShpGroup = oShp
oShpGroup.Name = “#” & msoAutoshapeTypeValue & “_”

With oShp
With .Fill
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
End With
With .Line
.DashStyle = msoLineSolid
.Transparency = 0
End With
With .TextFrame
With .Characters
.Text = oShp.Adjustments.Count
.Font.Color = 1
‘.Font.Name = “Garamond”
‘.Font.size = 12
End With
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
‘oCell.Offset(0, 2).Value = oShp.Adjustments.Count
‘If oShp.Adjustments.Count > 0 Then
‘ For lgAdjustment = 1 To oShp.Adjustments.Count
‘ ‘Add adjustment counter
‘ Set oShpConnector = .Shapes.AddShape(msoShapeRectangle, _
‘ oShp.Left, _
‘ oShp.Top + oShp.Heigth, _
‘ oShp.Left + oShp.Width, _
‘ oShp.Top)
‘ Next lgAdjustment
‘End If

oShp.Name = “#” & msoAutoshapeTypeValue

If oShp.ConnectionSiteCount > 0 Then
lgConnector = 0
For lgConnector = 1 To oShp.ConnectionSiteCount
‘Add connector Pointers
Set oShpConnector = .Shapes.AddConnector(msoConnectorCurve, _
0, _
0, _
0, _
0)
With oShpConnector
With .ConnectorFormat
.BeginConnect ConnectedShape:=oShp, ConnectionSite:=lgConnector
.EndConnect ConnectedShape:=oShp, ConnectionSite:=lgConnector
End With
sgLeft = .Left – 10
sgTop = .Top – 10
.Delete
End With

‘Add connector markers
Set oShpCtr = .Shapes.AddShape(Type:=msoShapeOval, _
Left:=sgLeft, _
Top:=sgTop, _
Width:=20, _
Height:=20)
With oShpCtr
.Name = “#” & msoAutoshapeTypeValue & “_” & lgConnector
With .Fill
.Transparency = 1
End With
With .Line
.DashStyle = msoLineDashDotDot
.Transparency = 1
End With

If .Connector Or .Type = msoLine Then
.Line.EndArrowheadStyle = msoArrowheadTriangle

‘ rough approximation of the Excel 2007 preset line style #17
.Line.Weight = 2
.Line.ForeColor.RGB = RGB(192, 80, 77)
.Shadow.Type = msoShadow6
.Shadow.IncrementOffsetX -4.5
.Shadow.IncrementOffsetY -4.5
.Shadow.ForeColor.RGB = RGB(192, 192, 192)
.Shadow.Transparency = 0.5
.Visible = msoTrue
End If
With .TextFrame
With .Characters
.Text = lgConnector
.Font.Color = 1
‘.Font.Name = “Garamond”
‘.Font.size = 12
End With
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With

‘Add Connector to Group
‘Set oShpGroup = .Shapes.Range(Array(oShpGroup.Name, oShpCtr.Name)).Group
Next lgConnector
End If
End If
NextShp:
On Error GoTo 0
Next oCell
End With
End Sub

Once we have the basic shapes, we can focus in what can be done to resemble a CAD application. Mostly, we need a Command entry area, a Command History area, a drawing area, some menus,… and little more. Lets face how to achive all this functionality.

CAD Paper space

So, get a new blank worksheet, add an ActiveX label control (named lbXYZ for tracking the cursor position), two ActiveX textbox controls (named txtCommand and txtHistory), and throw the following code into its coding section (ALT+F11):

[sourcecode language=”vb”]

Option Explicit
Private Const g_Base As Long = 0
‘!!!!!!!!!!

Public Type tPoint
X As Double
Y As Double
Z As Double
End Type

Public Type tPoly ‘also for 3D face?…
‘Id As Long ‘4 bytes

‘Properties
Layer As Long ‘4 bytes
Group As Long ‘4 bytes
Thickness As Single ‘4 bytes
Color As Long ‘4 bytes
Interior As Long ‘4 bytes

‘Geometry
TypePol As Long ‘8 bytes
Lft As Double ‘8 bytes
Top As Double ‘8 bytes
Height As Double ‘8 bytes
Width As Double ‘8 bytes
Rotation As Double ‘8 bytes
Closed As Boolean

Pointº As Integer ‘2 bytes
Point() As tPoint ‘Pointº * 24 bytes
Bulge() As Double ‘Pointº * 8 bytes
Offset As Double ‘8 bytes

‘Comments
Commentº As Long ‘4 bytes
Comment As String ‘Commentº bytes
End Type

Public Type tSpline
‘Id As Long ‘4 bytes

‘Properties
Layer As Long ‘4 bytes
Group As Long ‘4 bytes
Thickness As Single ‘4 bytes
Color As Long ‘4 bytes
Interior As Long ‘4 bytes

‘Geometry
‘TypePol As Long ‘8 bytes
Lft As Double ‘8 bytes
Top As Double ‘8 bytes
Height As Double ‘8 bytes
Width As Double ‘8 bytes
Rotation As Double ‘8 bytes
Closed As Boolean

Pointº As Integer ‘2 bytes
Point() As tPoint ‘Pointº * 24 bytes
Bulge() As Double ‘Pointº * 8 bytes
Offset As Double ‘8 bytes

‘Comments
Commentº As Long ‘4 bytes
Comment As String ‘Commentº bytes
End Type

Public Type tArc
‘Id As Long ‘4 bytes

‘Properties
Layer As Long ‘4 bytes
Group As Long ‘4 bytes
Thickness As Single ‘4 bytes
Color As Long ‘4 bytes
Interior As Long ‘4 bytes

‘Geometry
Lft As Double ‘8 bytes
Top As Double ‘8 bytes
Height As Double ‘8 bytes
Width As Double ‘8 bytes
SemiaxisA As Double ‘8 bytes ‘clockwise “> 0”, “< 0" counter-clockwise
SemiaxisB As Double '8 bytes
StartAngle As Double '8 bytes
EndAngle As Double '8 bytes
Rotation As Double '8 bytes
Offset As Double '8 bytes
Closed As Boolean

'Comments
Commentº As Long '4 bytes
Comment As String 'Commentº bytes
End Type

'Public Type tMesh
' 'Id As Long '4 bytes
'
' 'Properties
' Layer As Long '4 bytes
' Group As Long '4 bytes
' Thickness As Single '4 bytes
' Color As Long '4 bytes
' Interior As Long '4 bytes
'
' 'Geometry
' 'TypePol As Long '8 bytes
' Lft As Double '8 bytes
' Top As Double '8 bytes
' Height As Double '8 bytes
' Width As Double '8 bytes
' Rotation As Double '8 bytes
'
' PointAº As Integer '2 bytes
' SideA() As tPoint 'PointAº * 24 bytes
' BulgeA() As Double 'PointAº * 8 bytes
'
' PointBº As Integer '2 bytes
' SideB() As tPoint 'PointBº * 24 bytes
' BulgeB() As Double 'PointBº * 8 bytes
'
' 'Comments
' Commentº As Long '4 bytes
' Comment As String 'Commentº bytes
'End Type

Public Type tText
'Id As Long '4 bytes

'Properties
Layer As Long '4 bytes
Group As Long '4 bytes
Thickness As Single '4 bytes
Color As Long '4 bytes
Interior As Long '4 bytes

'Geometry
Lft As Double '8 bytes
Top As Double '8 bytes
Height As Double '8 bytes
Width As Double '8 bytes
Ground As tPoly '*** bytes
Rotation As Double '8 bytes
Autofit As Boolean '8 bytes
AlignmentH As Long '4 bytes
AlignmentV As Long '4 bytes
size As Single '4 bytes

'Text
Textº As Long '4 bytes
Text As String 'Textº bytes

'Comments
Commentº As Long '4 bytes
Comment As String 'Commentº bytes
End Type

Public Type tCAD
Viewportº As Long
Viewport() As tPoly

Layerº As Long
Layer() As String * 256

Polyº As Long
Poly() As tPoly

Splineº As Long
Spline() As tSpline

Arcº As Long
Arc() As tArc

Textº As Long
Text() As tText
End Type

'VarType(varName) vbVarType
'Value Constant
' 0 vbEmpty
' 1 vbNull
' 10 vbError
' 8192 vbArray

' 17 vbByte
' 11 vbBoolean
' 2 vbInteger
' 3 vbLong
' 20 vbLongLong '(defined only on implementations that support a LongLong value type)
' 4 vbSingle
' 5 vbDouble
' 8 vbString

' 7 vbDate
' 14 vbDecimal
' 6 vbCurrency
' 13 vbDataObject
' 36 vbUserDefinedType
' 9 vbObject
' 12 vbVariant

Private aCmd() As String
Private aShrt() As String
Private PtrCmd() As Long
Private bEnableEvents As Boolean

'– LISTENERS ——————-
Public bClickListener As Boolean
Public bSelectListener As Boolean
Public bTextListener As Boolean
Public oPointListener As tPoint
Public strShpListener As String

Public lgListen As Long 'Counter for number of clicks it has to listen to before TRUE (zero for undefined)
Public msoAutoshapeTypeValue As Long 'Autoshape type to draw
'——————————–

'– MOUSE ———————–
Public LastX As Long
Public LastY As Long
Public LastZ As Long
'——————————–
Private Sub txtCommand_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' txtComman.Select
End Sub
'Set for txtHistory and txtCommand:
' Multiline = True
' SelectionHide = False
' Scrollbars
Private Sub txtCommand_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
With txtHistory
.Value = .Value & vbNewLine & txtCommand.Value
'txtHistory. autoscroll to last line
'In VB6: .SelectionStart = .Text.length
'In VB6: .ScrollToCaret()
lgLen = lgLen + Len(txtCommand.Value)
.SelStart = lgLen 'Len(.Value)
End With
txtCommand.Value = vbNullString 'Clear content
ElseIf KeyCode = 32 Then
With txtCommand
'Look for command if no spaces before:
If .Value = vbNullString Then
'Repeat last command
.Value = LastCmd & VBA.Chr(32)
ElseIf VBA.InStrRev(.Value, VBA.Chr(32), Len(.Value) – 1) = 0 Then
LastCmd = VBA.Trim$(.Value)
'Run associated command function
'Application.Run("fcmd_" & LastCmd)
End If
End With
End If
End Sub
Private Sub Worksheet_Activate()
bNoFollow = True
'Do
' Me.lbXYZ.Caption = "X=" & MouseX & ";" & "Y = " & MouseY ' & ";" & "Z = " & MouseZ
' DoEvents
'Loop While bNoFollow
End Sub
Private Sub Worksheet_Deactivate()
bNoFollow = False
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Select near entities…
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Me.lbXYZ.Caption = "X=" & MouseX & ";" & "Y = " & MouseY ' & ";" & "Z = " & MouseZ
LastCell = ActiveCell.Address(True, True)
Me.txtCommand.Activate
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.lbXYZ.Caption = "X=" & MouseX & ";" & "Y = " & MouseY ' & ";" & "Z = " & MouseZ
End Sub

As you can be see, there are a short number of public variables used all along the worksheet and the userforms, so information can be passed from one procedure to another and to set conditions to roll on the alternatives.

Also, it is insinued that we need an object structure to store all the drawing information (Lines, Polylines, Arcs, Splines, Texts, Meshes,…) so I/O operations can be performed. Export/Import format can be anyone, KML, DXF,… but it has to be coded as an apart.

Entering COMMANDS

Sooner than later we’ll have to deal on a method that lets us enter CAD commands. They have to be introduced on txtCommand ActiveX control, waiting for commands to be entered through keyboard, but first we must gain focus for it, avoiding Excel ActiveCell’s default focus. This only can be done via code.

A not comprehensive list of CAD commands can be obtained from http://academics.triton.edu/faculty/fheitzman/commands.html, and also the complete list of command shortcuts aliases: https://www.autodesk.com/shortcuts/autocad.

It’s cristal clear that all this commands have to be programmed, as few can be achieved directly via Excel Shape methods. So there is still plenty to do, coding function procedures for the commands, i.e. for 3DFACE command:

[sourcecode language=”vb”]
Public Function fcmdCAD_3DFACE() As Boolean
‘ Creates a three-dimensional face
Dim strRetVal As String
Dim lgRetVal As Long
‘Dim oPolygon() As tPoint
Dim lgPoint As Long
Dim bPoint As Boolean
For lgPoint = 0 To 3
‘Do
‘ strRetVal = VBA.InputBox(Prompt:=”Invisible edge/:”, _
Default:=”First” & ” point of 3D face>:”)
‘ bPoint = fTextToPoint(strRetVal, oPoint)
‘ oPolygon(g_Base + lgPoint) = oPoint
‘Loop Until bPoint
Next lgPoint
‘If Not fCoplanar(oPolygon(g_Base + 3), oPolygon(g_Base + 0), oPolygon(g_Base + 1), oPolygon(g_Base + 2)) Then
‘ lgRetVal = vba.msgbox(“Points are not coplanar, modify Z to be coplanar?”, vbYesNo + vbExclamation, “W A R N I N G”)
‘ If lgRetVal = vbYes Then
‘ modify Z to be coplanar…
‘ Else
‘ fcmdCAD_3DFACE = False
‘ Exit Function
‘ End If
‘End If
‘Create 3D face polygon
‘…
fcmdCAD_3DFACE = True
End Function

COMMANDS from menus/dockbars

In a CAD application, there are also dockbars (or floating menus) to enter commands via mouse clicks. In order to do so, a Userform can be arranged to look like a floating menu (turning ShowModal property to False).

Drawing area

Before going further, we must set some conventions, mostly on how user shapes will be named, and for my convenience I’ve followed the following criteria (can be adapted to one’s needings):

  • Shape name should start with “#” character, followed by its assigned name (Id code) represented by a number.
  • If shape is not in layer “0” then insert, at the end of the name, the layer name preceded by “@” character.

Finally we need a drawing area that can be easily recognised via code. So lets name it with special carácter “•” (ALT+7) in the beggining. In order to be functional, we need to track mouse position and act as a listener. To achieve this we can fool Excel with a temporal “•Tmp” Excel.Shape, on top of drawing area, in order to get that Click listener, associating a global macro to start the listener, and another specific one to the “•Tmp” shape in order to stop the listening once it’s clicked. The shape will be only set as visible when the listener bClickListener is active, so that it does not interfere to changing cell selection when not needed.

[sourcecode language=”vb”]
Public Sub sListening()
bClickListener = True
With ActiveSheet
strShpListener = “•Tmp”
.Shapes(strShpListener).Visible = True
Do
.lbXYZ.Caption = “X=” & MouseX & “, ” & “Y = ” & MouseY ‘ & “, ” & “Z = ” & MouseZ
DoEvents
Loop While bClickListener
End With
End Sub

Public Sub sListener()
With ActiveSheet
bClickListener = False
‘Actualize Mouse position
.lbXYZ.Caption = “X=” & MouseX & “, ” & “Y = ” & MouseY ‘ & “, ” & “Z = ” & MouseZ
.txtCommand.Value = “”
.Shapes(strShpListener).Visible = False
End With

 

With every new shape that is added we need to properly set the OnAction property in order to take control back each time a shape is clicked. To do this we can use the procedure builder that is exposed in this post. The procedure that we are going to set in the OnAction should, at least, determine if SHFT or CTRL keys are pressed (for multiple selection), and send/store the shape name, the unique Id code, and basic properties of the shape, and then return focus to txtCommand. If needed, it should set visible (with transparency) a txtShape control in order to operate on the shape properties.

We need some public variables to store the edition status: aItem() As tCAD_Item (UDT where to store properties for that shape); aSelected() As String (where to store the Id of the -selected- shapes); btxtShape for enabling or disabling the direct edition of  the shape; ….

The best part of all of this development is that it can be easily adapted to work on a userform, so better capacities can be achieved, using API to draw on the userform.

A very basic skechup of this application concept could be downloaded if WordPress let upload XLMS or even ZIP files, which is not the case. So for now, only the code posted 😉