Message 1 of 2
Having Problems opening a DWG through vba code in Access.

Not applicable
02-22-2001
11:10 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have a piece of code I wrote to run within MS Access 2000. It starts
AutoCAD, opens a drawing and then pulls the title block information from
that title block and feeds it into a table. Finally the code will close off
the drawing. The problem I'm having lies in the opening of a AutoCAD .dwg
file I believe. I did a fresh intall of AutoCAD (Full Install) on two
machines. The first machine executes the code fine and populates the
database. On the second machine, at opening the drawing it asks for a
template file. This requires the user input on the AutoCAD end and in the
end doesn't extract any data. Can anyone help me out on what I can do here.
Do I need to modify my code or is there a setting in autocad to disable the
asking for a template?
Private Sub Command2_Click()
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
Dim project As Object
Dim blk As AcadObject
Dim blockrefobj As AcadBlockReference
Dim varAttributes As Variant
Dim strAttributes As String
Dim I As Integer
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application.15")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application.15")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Set acadDoc =
GetObject("P:\Projects\2001\01-342-01\Elect\Dwgs\01-342-01E02.dwg")
acadApp.Visible = True
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Tbl_Drawings1")
MsgBox ("Drawing Open")
For Each blk In acadDoc.PaperSpace
If blk.EntityName = "AcDbBlockReference" Then
Set blockrefobj = blk
If blockrefobj.Name = "24X36B" Then
rst.AddNew
If blockrefobj.HasAttributes Then
varAttributes = blockrefobj.GetAttributes
rst![Handle] = blockrefobj.Handle
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes &
varAttributes(I).TextString & Chr(13)
'MsgBox varAttributes(I).TagString
If varAttributes(I).TagString = "PROJECT1" Then
rst![Project1] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "PROJECT2" Then
rst![Project2] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "PROJECT3" Then
rst![Project3] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION1" Then
rst![Description1] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION2" Then
rst![Description2] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION3" Then
rst![Description3] = varAttributes(I).TextString
End If
Next I
End If
rst.Update
End If
End If
Next
MsgBox strAttributes
acadDoc.Close
End Sub
AutoCAD, opens a drawing and then pulls the title block information from
that title block and feeds it into a table. Finally the code will close off
the drawing. The problem I'm having lies in the opening of a AutoCAD .dwg
file I believe. I did a fresh intall of AutoCAD (Full Install) on two
machines. The first machine executes the code fine and populates the
database. On the second machine, at opening the drawing it asks for a
template file. This requires the user input on the AutoCAD end and in the
end doesn't extract any data. Can anyone help me out on what I can do here.
Do I need to modify my code or is there a setting in autocad to disable the
asking for a template?
Private Sub Command2_Click()
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
Dim project As Object
Dim blk As AcadObject
Dim blockrefobj As AcadBlockReference
Dim varAttributes As Variant
Dim strAttributes As String
Dim I As Integer
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application.15")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application.15")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Set acadDoc =
GetObject("P:\Projects\2001\01-342-01\Elect\Dwgs\01-342-01E02.dwg")
acadApp.Visible = True
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("Tbl_Drawings1")
MsgBox ("Drawing Open")
For Each blk In acadDoc.PaperSpace
If blk.EntityName = "AcDbBlockReference" Then
Set blockrefobj = blk
If blockrefobj.Name = "24X36B" Then
rst.AddNew
If blockrefobj.HasAttributes Then
varAttributes = blockrefobj.GetAttributes
rst![Handle] = blockrefobj.Handle
For I = LBound(varAttributes) To UBound(varAttributes)
strAttributes = strAttributes &
varAttributes(I).TextString & Chr(13)
'MsgBox varAttributes(I).TagString
If varAttributes(I).TagString = "PROJECT1" Then
rst![Project1] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "PROJECT2" Then
rst![Project2] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "PROJECT3" Then
rst![Project3] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION1" Then
rst![Description1] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION2" Then
rst![Description2] = varAttributes(I).TextString
End If
If varAttributes(I).TagString = "DESCRIPTION3" Then
rst![Description3] = varAttributes(I).TextString
End If
Next I
End If
rst.Update
End If
End If
Next
MsgBox strAttributes
acadDoc.Close
End Sub