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