Help with VBA automation

Help with VBA automation

Anonymous
Not applicable
279 Views
3 Replies
Message 1 of 4

Help with VBA automation

Anonymous
Not applicable
I am having a real painful time trying to get my Access97 form to work with AutoCAD 14.

I have some VBA code that is supposed to fire up a session of AutoCAD and insert some text.

No matter what code I try to use I can only open autocad, nothing else. I have referenced AutoCAD in my access97 database and used code that works on other people's computers.

I have attached code that opens a drawing and inserts specific text in certain places. No matter what I try it doesn't work. AutocAD just opens up and sits there.

Can anybody please help me with this, or point me some kind of direction?

Thanks
David
0 Likes
280 Views
3 Replies
Replies (3)
Message 2 of 4

Anonymous
Not applicable
Try turning the error handling back on (On Error
GoTo 0) after you don't need it anymore (right after the application objects
have been established). This may allow the code to break and alert you to where
the problem is. It doesn't appear there's anything wrong after a quick look
though. Also, are you sure the text is not being created? I've had this type of
thing run, and then not appear until after drawing view is
regenerated.

 



style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">I
am having a real painful time trying to get my Access97 form to work with
AutoCAD 14.

I have some VBA code that is supposed to fire up a session of AutoCAD and
insert some text.

No matter what code I try to use I can only open autocad, nothing else. I
have referenced AutoCAD in my access97 database and used code that works on
other people's computers.

I have attached code that opens a drawing and inserts specific text in
certain places. No matter what I try it doesn't work. AutocAD just opens up
and sits there.

Can anybody please help me with this, or point me some kind of direction?

Thanks
David





Public Sub text()
Dim mobjAcadApp As Object
Dim mobjAcadDoc As
Object
    Dim objAcadApp As Object
   
Dim objAcadDoc As Object
    Dim strFilename As
String
    Dim strDirname As String
    On
Error Resume Next
    Set objAcadApp = GetObject(,
"AutoCAD.Application")
    'setq reference to AutoCAD
Application
   
    If Err
Then
        'if there is an error
(AutoCAD not open)
       

       
Err.Clear
        'clear the
error
       

        Set objAcadApp =
CreateObject("AutoCAD.Application")
       
'open AutoCAD
        Set objAcadApp =
GetObject(,
"AutoCAD.Application")
        'setq
reference to AutoCAD Application
       

        If Err
Then
            'if
there is another
error
           

            MsgBox
Err.Description
           
'inform
user
           

            Exit
Sub
           
'exit
application
           

        End
If
       
    End
If
   
   
   
objAcadApp.Visible = True
    'Make Autocad
Visible
    Dim docObj As AcadDocument
   
Set docObj = Application.Documents.Add
    'set reference to
active document

    'open new
drawing
    'set reference to active
document
    Set objAcadDoc =
objAcadApp.ActiveDocument
   
    Dim
strTemplateFileName As String
    strTemplateFileName =
""
   
    objAcadDoc.New
strTemplateFileName
    Dim textObj As
AcadText
    Dim strTextString As
String
    Dim adblInsertionPoint(0 To 2) As
Double
    Dim dblHeight As Double
   

   
   
'Project Number:
11980120
    ' Define the text object
   
strTextString = "Project Number: 11980120"
   
adblInsertionPoint(0) = 0
    adblInsertionPoint(1) =
0
    adblInsertionPoint(2) = 0
   
dblHeight = 1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)

'Assembly Number: A -3200014 - 0
    '
Define the text object
    strTextString = "Assembly Number:
A -3200014 - 0"
    adblInsertionPoint(0) =
0
    adblInsertionPoint(1) = -2
   
adblInsertionPoint(2) = 0
    dblHeight =
1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)

'Sub-Assembly Number: A-9900001-000
    '
Define the text object
    strTextString = "Sub-Assembly
Number: A-9900001-000"
    adblInsertionPoint(0) =
0
    adblInsertionPoint(1) = -4
   
adblInsertionPoint(2) = 0
    dblHeight =
1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
'Item Number: 02
    ' Define the text
object
    strTextString = "Item Number:
02"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -6
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
'Quantity: 3
    ' Define the text
object
    strTextString = "Quantity:
3"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -8
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
   
End Sub
0 Likes
Message 3 of 4

Anonymous
Not applicable
Here is your code all fixed up.

-- 

Joe Sutphin
Author of "AutoCAD 2000 VBA Programmers Reference"
ISBN
#1861002564

 

Public Sub text()
Dim mobjAcadApp As Object
Dim mobjAcadDoc As
Object
Dim objAcadApp As Object
Dim objAcadDoc As Object
Dim
strFilename As String
Dim strDirname As String
   

    On Error Resume Next
   

    Set objAcadApp = GetObject(,
"AutoCAD.Application")
    'setq reference to AutoCAD
Application
   
    If Err
Then
        'if there is an error
(AutoCAD not open)
       

       
Err.Clear
        'clear the
error
       

        Set objAcadApp =
CreateObject("AutoCAD.Application")
       
'open AutoCAD
       

        If Err
Then
            'if
there is another
error
           

            MsgBox
Err.Description
           
'inform
user
           

            Exit
Sub
            'exit
application
           

        End
If
       
    End
If
   
On Error GoTo HandleError
   

    'Make Autocad Visible
   
objAcadApp.Visible = True
   
    Set
objAcadDoc = objAcadApp.ActiveDocument
   

    Dim textObj As AcadText
    Dim
strTextString As String
    Dim adblInsertionPoint(0 To 2) As
Double
    Dim dblHeight As Double
   

'Project Number: 11980120
    ' Define the text
object
    strTextString = "Project Number:
11980120"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = 0
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString, adblInsertionPoint,
dblHeight)

 

'Assembly Number: A -3200014 - 0
    ' Define the text
object
    strTextString = "Assembly Number: A -3200014 -
0"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -2
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString, adblInsertionPoint,
dblHeight)

 

'Sub-Assembly Number: A-9900001-000
    ' Define the text
object
    strTextString = "Sub-Assembly Number:
A-9900001-000"
    adblInsertionPoint(0) =
0
    adblInsertionPoint(1) = -4
   
adblInsertionPoint(2) = 0
    dblHeight =
1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString, adblInsertionPoint,
dblHeight)
'Item Number: 02
    ' Define the text
object
    strTextString = "Item Number:
02"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -6
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString, adblInsertionPoint,
dblHeight)
'Quantity: 3
    ' Define the text
object
    strTextString = "Quantity: 3"
   
adblInsertionPoint(0) = 0
    adblInsertionPoint(1) =
-8
    adblInsertionPoint(2) = 0
   
dblHeight = 1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString, adblInsertionPoint,
dblHeight)
   
ExitHere:
    Exit
Sub
   
HandleError:
    MsgBox
Err.Description
    Resume ExitHere
   

End Sub


style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
I
am having a real painful time trying to get my Access97 form to work with
AutoCAD 14.

I have some VBA code that is supposed to fire up a session of AutoCAD and
insert some text.

No matter what code I try to use I can only open autocad, nothing else. I
have referenced AutoCAD in my access97 database and used code that works on
other people's computers.

I have attached code that opens a drawing and inserts specific text in
certain places. No matter what I try it doesn't work. AutocAD just opens up
and sits there.

Can anybody please help me with this, or point me some kind of direction?

Thanks
David





Public Sub text()
Dim mobjAcadApp As Object
Dim mobjAcadDoc As
Object
    Dim objAcadApp As Object
   
Dim objAcadDoc As Object
    Dim strFilename As
String
    Dim strDirname As String
    On
Error Resume Next
    Set objAcadApp = GetObject(,
"AutoCAD.Application")
    'setq reference to AutoCAD
Application
   
    If Err
Then
        'if there is an error
(AutoCAD not open)
       

       
Err.Clear
        'clear the
error
       

        Set objAcadApp =
CreateObject("AutoCAD.Application")
       
'open AutoCAD
        Set objAcadApp =
GetObject(,
"AutoCAD.Application")
        'setq
reference to AutoCAD Application
       

        If Err
Then
            'if
there is another
error
           

            MsgBox
Err.Description
           
'inform
user
           

            Exit
Sub
           
'exit
application
           

        End
If
       
    End
If
   
   
   
objAcadApp.Visible = True
    'Make Autocad
Visible
    Dim docObj As AcadDocument
   
Set docObj = Application.Documents.Add
    'set reference to
active document

    'open new
drawing
    'set reference to active
document
    Set objAcadDoc =
objAcadApp.ActiveDocument
   
    Dim
strTemplateFileName As String
    strTemplateFileName =
""
   
    objAcadDoc.New
strTemplateFileName
    Dim textObj As
AcadText
    Dim strTextString As
String
    Dim adblInsertionPoint(0 To 2) As
Double
    Dim dblHeight As Double
   

   
   
'Project Number:
11980120
    ' Define the text object
   
strTextString = "Project Number: 11980120"
   
adblInsertionPoint(0) = 0
    adblInsertionPoint(1) =
0
    adblInsertionPoint(2) = 0
   
dblHeight = 1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)

'Assembly Number: A -3200014 - 0
    '
Define the text object
    strTextString = "Assembly Number:
A -3200014 - 0"
    adblInsertionPoint(0) =
0
    adblInsertionPoint(1) = -2
   
adblInsertionPoint(2) = 0
    dblHeight =
1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)

'Sub-Assembly Number: A-9900001-000
    '
Define the text object
    strTextString = "Sub-Assembly
Number: A-9900001-000"
    adblInsertionPoint(0) =
0
    adblInsertionPoint(1) = -4
   
adblInsertionPoint(2) = 0
    dblHeight =
1
    ' Create the text object in model
space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
'Item Number: 02
    ' Define the text
object
    strTextString = "Item Number:
02"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -6
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
'Quantity: 3
    ' Define the text
object
    strTextString = "Quantity:
3"
    adblInsertionPoint(0) = 0
   
adblInsertionPoint(1) = -8
    adblInsertionPoint(2) =
0
    dblHeight = 1
    ' Create the text
object in model space
    Set textObj =
objAcadDoc.ModelSpace.AddText(strTextString,
adblInsertionPoint,
dblHeight)
   
End Sub
0 Likes
Message 4 of 4

Anonymous
Not applicable
Thank you for your Replies


Joe I am still having problems with this. Please bear with me on this, I am still learning.


From what I assume, correct me if I am wrong, if I want this code to run I am going to put your code behind a command button.


When I did this I get a compile-error:

User Defined type not defined


Then it highlights

Dim textObj As AcadText


I have the autocad object library referenced in my database? Should I be doing something else?


Thanks for your time,

David Oberer
0 Likes