Execute a Custom Command from an External VBA Source
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello Everyone, I have really enjoyed the detailed and useful information users share in these threads, so I decided to take my own chances.
My question is focused on running a custom command that I have generated from Excel, but I am open to any suggestions for the best way to accomplish the task at hand. This is what I want to do: Successfully run the attext command from and Excel VBA macro.
Currently I've gotten this far:
;THIS SCRIPT IS CALLED BY AN AUTOCAD COMMAND ; ;Turn off Dialog Boxes FILEDIA 0 ;Attribute Extraction Command (dialog suppressed) -attext ; ;Extraction type. 'C' for Comma Delimited, 'S' for Space Dilimited and Fixed Width, 'D' for DXF Format c ; ;Extraction template file path "C:/Documents and Settings/DiBlasiW/Desktop/Automating Automation/Extraction Testing/TestExtractionTemplate" ; ;Output file path "C:/Documents and Settings/DiBlasiW/Desktop/Automating Automation/Extraction Testing/TestExtraction" ; ;Turn on Dialog Boxes FILEDIA 1
This macro is embedded in a custom command: ^C^CFILEDIA;0;_SCRIPT;"C:/Documents and Settings/DiBlasiW/Desktop/Automating Automation/Extraction Testing/TestMacroScript.SCR";
'''''''''''''''''''''''''
'This is the Excel Macro'
'''''''''''''''''''''''''
Option Explicit
Public ACAD As AcadApplication
Public DWGSet As AcadDocuments
Public DWG As AcadDocument
Public Sub Imports()
On Error Resume Next
Call OpenACAD
Call OpenDrawing("C:\Documents and Settings\diblasiw\Desktop\Automating Automation\PDTest.dwg")
Call Script
End Sub
Private Sub OpenACAD()
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
If Err.Description > vbNullString Then
Err.Clear
Set ACAD = CreateObject("AutoCAD.Application")
End If
ACAD.Visible = True
Application.WindowState = xlMinimized
ACAD.WindowState = acMax
Set DWG = ACAD.ActiveDocument
End Sub
Private Sub OpenDrawing(ByVal DWGPath As String)
On Error Resume Next
Dim NotOpen As Boolean
If DWG.Path <> DWGPath Then 'Side note, this IF Statement does not accomplish the inteded goal. DWG.Path never equals DWGPath even when PDTest.dwg is already open
NotOpen = True
Else
NotOpen = False
End If
If NotOpen = True Then
Set DWG = ACAD.Documents.Open(DWGPath)
DWG.Activate
End If
End Sub
Private Sub Script()
'**********************************
'**********************************
'This is where I'm stuck. I cannot figure out a good way to execute the attext command here.
'**********************************
'**********************************
End SubI've tried ACAD.RunMacro but then I need a LISP program, and I am not having success figuring out how to utilize it.
I tried using DWG.SendCommand like this:
DWG.SendCommand ("FILEDIA 0 -attext C C:/PDTest.dwg C:/TestExtraction FILEDIA 1 ")but something happens when it gets to the file paths, and it stops interpretting the spaces as carrige returns.
I've also creat a new CUIx file, added a tab and panel to hold the custom command. The button works, but I can't think of a way to activate it from Excel.
I would really appreciate some guidance, I feel like I've gotten so far and I've come close to victory, but the last leg of the journey seems to be the toughest.