Excel 2010 - Autocad 2012 - Win 7 64 bit - Error 429 running Excel VBA code

[Mike_S_Jones]

I'm trying to start ACAD from a Excel using VBA - the code works fine-if ACAD is already running. I'm trying to make it a wee bit more user friendly and have the Excel VBA open ACAD if it isn't already running.

excel_vba_references.PNG

The references have been correctly set (I think)

vba_code_autocad_excel.PNG

The code comes from somewhere - too many sources to recall the exact location.

vba_code_error_429.PNG

The error message I receive.

I'm running 64 Bit AutoCAD and 64 bit Office 2010.

Sandbox mode is '2'

[Mike_S_Jones]

Going on three months and not one reply - no luck on my end either.

[Ed Jobe]

Have you tried setting a breakpoint and running in debug mode to see what line the error occurs at?

[fixo]

Going on three months and not one reply - no luck on my end either.

create .XlSM file then add this code in module named
modTestAcad, but before run this module select single cell before

Option Explicit
' require references to:

'Windows Script Host Object model

'AutoCAD 20XX Type Library

'AutoCAD Focus Control for VBA Type Library

'in the Tools -> Options -> General -> Error Trapping box -> Check "Break on Unhandled Errors"

Function acadVerNum() As String
Dim verNum As String

verNum = "HKEY_CLASSES_ROOT\AutoCAD.Drawing\CurVer\"
Dim wsh As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set wsh = CreateObject("WScript.Shell")
  'read key from registry
  Dim resKey As String
  resKey = wsh.RegRead(verNum)
  
 acadVerNum = Right(resKey, 2)
  Exit Function
  
ErrorHandler:
  'key was not found
 acadVerNum = ""
    
End Function

Public Sub testOpenAutoCAD()

Dim acad As AutoCAD.AcadApplication
Dim appNum As String
On Error GoTo ErrorHandler
appNum = acadVerNum
If appNum = "" Then
Exit Sub
End If
On Error Resume Next
Set acad = GetObject(, "Autocad.Application." & appNum)
If Err.Number = 429 Then
Err.Clear

On Error GoTo 0
Set acad = CreateObject("Autocad.Application." & appNum)
If Err Then
Exit Sub
End If
End If

acad.WindowState = acMax

Dim adoc As AutoCAD.AcadDocument
Set adoc = acad.ActiveDocument

Dim selRng As Range
Set selRng = Selection
selRng.Value2 = "Tested on: " & adoc.Name

Dim aspace As AutoCAD.AcadBlock

Set aspace = adoc.ActiveLayout.Block

Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim lw As Double
Dim clr As Integer


p1(0) = 0#: p1(1) = 0#: p1(2) = 0#
p2(0) = 100#: p2(1) = 100#: p2(2) = 0#

lw = acLnWt060
clr = "0"
Dim oLine As AcadLine
Set oLine = aspace.AddLine(p1, p2)
oLine.Lineweight = lw
oLine.Color = acMagenta

adoc.SetVariable "lwdisplay", 1
adoc.SetVariable "ltscale", 0.25
ZoomExtents

Set aspace = Nothing
Set adoc = Nothing
Set acad = Nothing


MsgBox "Pokey"

ErrorHandler:
  If Err.Number <> 0 Then
  MsgBox Err.Description
  End If
End Sub

[Mike_S_Jones]

@Fixo

Your code worked great - thanks for posting!

Very belated reply, but side projects at work always seem to get shunted to the side.

Thanks again.

Mike

[fixo]

Hi Mike,
I'm ery happy if this helps in your work
Cheers,