• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Starting and Killing an Application through VBA

NicGreen

Member
G,day All,

I'm currently looking at sending commands through to AutoCAD via an excel macro.

To open AutoCAD from Excel I have been using the following code

Code:
 On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If Err Then
        Err.Clear
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
  ' Set acadApp = GetObject(, "AutoCAD.Application")
  ' acadApp.Visible = True
    'If acadApp Is Nothing Then
    'Sleep (3000)
        'Set acadApp = CreateObject("AutoCAD.Application")
        'acadApp.Visible = True
        'Alive = "Yes"
    'Else
    'Alive = "No"
    'End If

To close AutoCAD after I am done I use

Code:
acadApp.Quit
Set acadApp = Nothing
Application.ScreenUpdating = True

What I'm currently having issue with is repetitive use of the macro. In the first instance of running the macro everything works fine. However on the second try the macro runs but does not execute the commands in AutoCAD (i believe it runs but doesnt execute because of an on error resume next line i need to have).

My query is.

Can I write some form of code that opens a new instance of AutoCAD, regardless of if autocad is open or not. Executes the macro in the new instance of AutoCAD then closes only the new instance?

I believe doing so may solve my repeatitive use issue.
 
I'll give it a shot I think what I might be dealing with is an orphaned process in this case acad.exe. what's the proper way to end our close them
 
I suspect that, if the rest of the code manipulates AutoCAD, you have some unqualified references to AutoCAD objects in there. That would lead to orphaned processes. If you post the code, we can probably help locate the problem.
 
Code:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub XrefAttach2Dwg()
Dim XrefRng As Range, XrefPathRng As Range, cell As Range, cxrefname As String, Xrefpaste As Range, cellx As Range, Alive As String, checkcellRange As Range, Checkcellval As String, fileName As String, pctCompl As Single, inRng As Range, n, myworkbook, cellxval As String, CurrentDWG As String, sleeptime As Integer, Tidy As Integer

Dim TempLoc As String
Dim LayName As Range
Dim acadApp As Object
TempLoc = "File Path/Drawing.dwt"

Set XrefRng = Range("Xref_Attach_Range")
Set XrefLookup = Range("Xref_Lookup")
Set inRng = Application.Range("Table4[DWG Path]")
Set wS1 = Worksheets("Send AutoCAD Commands")
Set XrefPathRng = Range("Xref_Paths")
Set outCell = wS1.Range("E18") 'change to be first cell of output range
Set inlay = Application.Range("Table4[Layout]") 'set copy location of layout name
Set outlay = wS1.Range("F16") 'set paste location of layout name
i = 0
Startcolumn = "F"
Endcolumn = "N"
n = 0
Currrow = 18
Application.ScreenUpdating = False
Checkcellval = Worksheets("Project builder").Range("F6").Value

'------------Checking if XRef's Exist-------------------
For Each checkcell In XrefPathRng
Checkcellval = checkcell.Value
'MsgBox checkcell.Address
If Checkcellval = "" Then
  GoTo SkipCell
  Else
  End If
If Dir(Checkcellval) <> "" Then
  'MsgBox "File exists."
Else
  MsgBox ("The following Xref does not exist:" & vbNewLine & Checkcellval & vbNewLine & "Please check the file and try again")
  Exit Sub
End If
i = 1 + i
SkipCell:
Next checkcell
'-------End Checking Xrefs---------------

If MsgBox("Excel and AutoCAD will not be accessible during the operation Are you sure you would like to continue?", vbYesNo) = vbNo Then Exit Sub
Worksheets("Project Builder").Range("F19").Select


'-------------Creating Drawing--------------------
For Each incell In inRng
'incell.Select
'MsgBox incell
    CurrentDWG = incell.Offset(0, -11).Value
    Set LayName = Worksheets("Project Builder").Cells(incell.Row, 1)
        If Dir(incell.Value) <> "" Then
          Tidy = 1
            GoTo DWGExist
        Else
           
    [B]On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    If Err Then
        Err.Clear
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If[/B]
  ' Set acadApp = GetObject(, "AutoCAD.Application")
  ' acadApp.Visible = True
    'If acadApp Is Nothing Then
    'Sleep (3000)
        'Set acadApp = CreateObject("AutoCAD.Application")
        'acadApp.Visible = True
        'Alive = "Yes"
    'Else
    'Alive = "No"
    'End If
       
    'Check (again) if there is an AutoCAD object.
    If acadApp Is Nothing Then
        MsgBox "Sorry, it was impossible to start AutoCAD!", vbCritical, "AutoCAD Error"
        Exit Sub
    End If
                AutoCAD.Application.Documents.Open TempLoc
                AutoCAD.Application.ActiveDocument.SendCommand ("LAYOUT" & vbCr & "R" & vbCr & "000" & vbCr & LayName & vbCr) 'renames the layout from default "000" to the name stored in LayName
                AutoCAD.Application.ActiveDocument.SaveAs incell.Value, AcSaveAsType.ac2007_dwg 'Saves the drawing to the incell value in a 2007  DWG format
        UserForm1.DWG.Caption = "Created" & CurrentDWG 'Updates the progress indicator to display drawing created
        End If



'Progress Bar Code Start

pctCompl = (n / (Range("Table4[DWG Path]").Count)) * 100

    progress pctCompl
    progressDWG CurrentDWG
'Progress Bar Code Ends
    'End If
'--------Searching XrefRange For Instances of "Yes"---------------
Sheets("Project Builder").Select
Currrow = Currrow + 1
Set Currrange = Range(Startcolumn & Currrow & ":" & Endcolumn & Currrow)

For Each cell In Currrange
'cell.Select
Sheets("Project Builder").Select
If cell.Value = "Yes" Then
sleeptime = 2000
cxrefname = Cells(17, cell.Column).Value
'MsgBox cxrefname & " " & ActiveCell.Address 'Use for Testing Variable Value

Else
sleeptime = 100
cxrefname = "No Xref to Attach"
End If

'--------once it finds an instance of yes search for Xref particulars-------------
Sheets("Project Builder").Select
For Each cellx In XrefLookup
cellxval = cellx.Value
    If cellxval = cxrefname Then
    Set Xrefpaste = cellx.Offset(0, 1)
    fileName = Replace(Dir(Xrefpaste), ".dwg", "")
AutoCAD.Application.ActiveDocument.ActiveSpace = acModelSpace
AutoCAD.Application.ActiveDocument.SendCommand ("FILEDIA" & vbCr & "0" & vbCr & "-Xref" & vbCr & "o" & vbCr & Xrefpaste & vbCr & "0,0" & vbCr & "1" & vbCr & "1" & vbCr & "0" & vbCr & "FILEDIA" & vbCr & "1" & vbCr) 'Attaches Xref into Drawing
AutoCAD.Application.ActiveDocument.SendCommand ("FILEDIA" & vbCr & "0" & vbCr & "-rename" & vbCr & "b" & vbCr & fileName & vbCr & cxrefname & vbCr & "FILEDIA" & vbCr & "1" & vbCr) 'Renames Xref from default name to that specified in Project builder

UserForm1.DWG.Caption = "Attaching Xrefs to " & CurrentDWG 'Updates Progress Indicator to display that Xrefs are currently being attached to Drawings

Else
    End If

Next cellx
'--------End searching for xref particulars------------

Next cell

AutoCAD.Application.ActiveDocument.SendCommand ("FILEDIA" & vbCr & "0" & vbCr & "FILEDIA" & vbCr & "1" & vbCr & "COMMANDLINE" & vbCr) 'Quick Saves Drawing
AutoCAD.Application.ActiveDocument.Save
AutoCAD.Application.ActiveDocument.Close 'Closes AutoCAD
Sleep (sleeptime)
n = n + 1
Tidy = 0
DWGExist:
Next incell

'----------------End Searching XrefRange For Instances of "Yes"----------------
If Tidy = 0 Then
Sheets("Send AutoCAD Commands").Range("C13:O73").ClearContents
AutoCAD.Application.ActiveDocument.SendCommand ("FILEDIA" & vbCr & "1" & vbCr & "COMMANDLINE" & vbCr)

If Alive = "Yes" Then
AutoCAD.Application.Quit

End If

Else
End If
[B]acadApp.Quit
Set acadApp = Nothing[/B]
Application.ScreenUpdating = True

pctCompl = 100
UserForm1.Bar.Width = 246.5
progress pctCompl
    MsgBox "The project has been built. " & vbNewLine & n & " Drawing(s) were created.", vbInformation, "Done"
End Sub

Im new to all this so my code structure might not be great. Any suggestions are appreciated
 
You need to replace every occurrence of
Code:
AutoCAD.Application
with
Code:
acadApp
(apart from the ones in the GetObject and CreateObject calls.)

I assume you have a reference to AutoCAD set, otherwise the AutoCAD constants you're using have no value (e.g. acModelSpace)
 
I assume i do as the as acModelSpace works. Ive selected the acad library. Ill test it out tomorrow. Are you able to explain why what i was doing wasnt working.
 
You created an AutoCAD.Application object (acadApp) but then didn't use it. By referring directly to the generic AutoCAD.Application class instead, you created an implicit variable that you cannot then destroy, and that is what resulted in the orphaned process and errors on the second pass.
 
Back
Top