Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to connect AutoCAD to Access

AutoCAD VB/VBA

How to connect AutoCAD to Access

by  TCARPENTER  Posted    (Edited  )
Lately, several requests asking how to connect or link AutoCAD to Access have been posted. This is a fairly easy thing to do with just a little VBA and some basic database skills. I'll try and keep this as basic as I can. The most common task seems to be exporting title block information to an Access database/table so this is the premise I'll demonstrate here, but the techniques described could be applied to any block with attributes. The error trapping is minimal and the code presented here may or may not represent the most efficient code but for demonstration purposes, it should more than do the trick.

The first thing to know is how the attributes in your title block correlate to your database fields. First let's look at our title block and its attributes. Let's say we have a title block named TitleBlock with the following attributes:
[tt][ul]
Tag Prompt
[li]DrawingNumber Enter a drawing number.[/li]
[li]FileName Enter the file name.[/li]
[li]Title1 Drawing description line 1.[/li]
[li]Title2 Drawing description line 2.[/li]
[li]Title3 Drawing description line 3.[/li]
[li]Scale Drawing scale.[/li]
[li]DrawnBy Drawn by (first initial, last name - no spaces).[/li]
[li]Date Date drawing started.[/li]
[/ul][/tt]
Now if you don't already have an Access database, I usually recommend (especially for first timers) just use the tags of the attributes in your title block as the field names in your table. Let's say we have a brand new Access database called DrawingsDatabase.mdb in this database we'll create a table called tblDrawings. Our structure should look something like this:
[tt][ul]
Field Name Data Type Description
[li]FileName - Text - File name/Primary Key.[/li]
[li]DrawingNumber - Text - Drawing number.[/li]
[li]Title1 - Text - First line of drawing description.[/li]
[li]Title2 - Text - Second line of drawing description.[/li]
[li]Title3 - Text - Third line of drawing description.[/li]
[li]Scale - Text - Drawing plotted scale.[/li]
[li]DrawnBy - Text - Designers name.[/li]
[li]Date - Date - Date drawing started.[/li]
[/ul][/tt]
You may have noticed the FileName field has "Primary Key" in the description field. You'll want to use some field as your primary key and I usually recommend the file name of the drawing be the primary key simply because most users are familiar with not being allowed to create duplicate file names within the same directory - this will have the same effect; the database will not allow duplicate file names, thus eliminating redundant data.

Now the next step to linking AutoCAD to Access is we'll now need to create the physical link, and in this case, it will be VBA code. The code presented here will accomplish three things 1) it will connect to the database, 2) it will parse the drawing looking for a valid title block, 3) it will populate our database. Now I know there's a lot of debate out there about which way is better and the code presented here probably is not the best in terms of programming discipline, and it may not represent the most flexible bit of programming but this is just a primer - so bear with me.

For the first section of code, I usually try to scan the drawing searching for valid title blocks before I try creating the connection to Access - if I don't find a valid title block, there's no sense in doing all that extra work if we don't have to. Then if we've found a valid title block, the next step is to try and connect to our database. If we're successful here, then it's time to double check the database table to be sure we're not overwriting important data - we'll give the user the option to do so though just in case you need to update information.

The first thing we'll need to do in the VBA editor from the pull down menus Tools->References... is add a reference to Microsoft ActiveX Data Objects 2.x Library where x is 0 through 8. Select any which one of these you have listed - if you have multiples, I suggest selecting the latest and greatest in your list. Now in the General section of our VBA routine add the following:

Code: 
Public AcadDoc      As AcadDocument      'Current AutoCAD drawing document.
Public cnnDataBse   As ADODB.Connection  'ADO connection to database.
Public rstAttribs   As ADODB.Recordset   'ADO recordset to update.

You'll notice the code makes use of a two functions which are very handy to have; BuildFitler from Frank Oquendo, and vbdPowerset from Randall Rath. Both of these functions are very handy and should be a part of your VB/VBA library of tools see [link http://www.tek-tips.com/faqs.cfm?fid=5792] faq687-5792 [/link] for these routines. Two other functions you will require for accomplishing our task are Connect and AttribExtract which are listed below:

Connect
Code: 
Public Function Connect(strDatabase As String, strTableName As String)
  '
  ' Title     : Connect
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/05/2005 08:57:36 AM
  ' Last Edit : 03/05/2005 08:57:36 AM, TDC
  '
  ' Description:
  ' »»»»»»»»»»»»
  '   This function is used to connect to an
  '   ADO record source.
  '
  ' Additional files/functions required:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '   1) None
  '
  ' Requires the following variables:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '    * Input assignments
  '      1) strDatabase - The database file location.
  '      2) strTableName - Table within the database to open.
  '
  ' Example usage:
  ' »»»»»»»»»»»»»»
  '    Connect "Drawings.mdb", strTblName
  '
  ' Updates:
  ' »»»»»»»»
  ' 03/04/2005 08:57:36 AM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' »»»»»»»»»»»»»»»»»»»»»»
  '    1) None
  '
  ' Connect begins here:
  ' ùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùù
  
  Dim strSQL As String  'SQL string for extracting recorsets.
  
  strSQL = "SELECT * FROM [" & strTableName & "]"
    
  Set cnnDataBse = New ADODB.Connection
  With cnnDataBse
    .CursorLocation = adUseServer
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Data Source").Value = strDatabase
    .Open
  End With
  
  Set rstAttribs = New ADODB.Recordset
  With rstAttribs
    .LockType = adLockPessimistic
    .ActiveConnection = cnnDataBse
    .CursorType = adOpenKeyset
    .CursorLocation = adUseServer
    .Source = strSQL
  End With
  
  rstAttribs.Open , , , , adCmdText
  
  If rstAttribs.RecordCount <> 0 Then
    rstAttribs.MoveFirst
  End If

End Function

AttribExtract
Code: 
Public Function AttribExtract(blkRef As AcadBlockReference)
  '
  ' Title     : AttribExtract
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/05/2005 08:49:24 AM
  ' Last Edit : 03/05/2005 08:49:24 AM, TDC
  '
  ' Description:
  ' »»»»»»»»»»»»
  '   This function is used to extract attributes
  '   from a supplied block, and return the array
  '   to the calling function.
  '
  ' Additional files/functions required:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '   1) None
  '
  ' Requires the following variables:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '    * Input assignments
  '      1) blkRef - Inserted block (not the definition)
  '                  to extract attributes.
  ' Example usage:
  ' »»»»»»»»»»»»»»
  '    AttribExtract(ssTitleBlock(0))
  '
  ' Updates:
  ' »»»»»»»»
  ' 03/04/2005 08:49:24 AM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' »»»»»»»»»»»»»»»»»»»»»»
  '    1) None
  '
  ' AttribExtract begins here:
  ' ùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùù
  
  Dim vArray As Variant   'Attribute array.
  
  If blkRef.HasAttributes Then
    vArray = blkRef.GetAttributes
    AttribExtract = vArray
  End If

End Function

Now, with some of the more mundane functions tucked away into their own neat little routines, we can concentrate on how the main routine should function. The first thing the routine will need to do is parse or query the drawing searching for the "known" title block. Then, if it's found we'll need the routine to check our database table for the existence of this particular drawing, and if found, prompt the user accordingly. Then finally, our routine will need to either add a record to our database table or update the existing information already in the table, or do nothing depending upon the user's response. Here's what this code might look like:

Code: 
Public Sub ExportAttribs()
  '
  ' Title     : ExportAttribs
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/05/2005 11:57:39 AM
  ' Last Edit : 03/05/2005 11:57:39 AM, TDC
  '
  ' Description:
  ' »»»»»»»»»»»»
  '   This function is used as the main workhorse - returns nothing.
  '
  ' Additional files/functions required:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '   1) AttribExtract
  '   2) BuildFilter
  '   3) Connect
  '   4) vbdPowerSet
  '
  ' Requires the following variables:
  ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  '    * Input assignments
  '      1) strTblName - This the name of the database table
  '                      to be populated by the title block
  '                      attributes.
  '      2) AcadDoc    - Current AutoCAD drawing document must be global.
  '      3) cnnDataBse - Connection to database must be global.
  '      4) rstAttribs - Recordset to update/append to database, must be global.
  '
  ' Example usage:
  ' »»»»»»»»»»»»»»
  '    ExportAttribs "Drawings"
  '
  ' Updates:
  ' »»»»»»»»
  ' 03/04/2005 11:57:39 AM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' »»»»»»»»»»»»»»»»»»»»»»
  '    1) None
  '
  ' ExportAttribs begins here:
  ' ùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùùù
  
  Dim ssTitleBlock As AcadSelectionSet  'Selection set/title block to export.
  Dim intData()    As Integer           'DXF code for filtering.
  Dim varData()    As Variant           'DXF code description for filtering.
  Dim varAttribs   As Variant           'Attribute array from title block.
  Dim intAttribCnt As Integer           'Attribute array bounds.
  Dim fldAttribs   As ADODB.Field       'ADO fields from recordset.
  Dim strSearch    As String            'String to search for duplicates.
  Dim blnDuplicate As Boolean           'Duplicate record flag.
  Dim result       As VbMsgBoxResult    'User prompted responses.
  Dim strTblName   As String            'Name of Access table to populate.
  
  ' Defaults.
  '
  On Error GoTo ExportAttribs_Error
  strTblName = "tblDrawings"  ' Table name in database.
  Set AcadDoc = ThisDrawing   ' Current drawing.
      
  ' Build the filter criteria.
  '
  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "<<Name of Title block goes here>>", _
                                -4, "and>"
                                
  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("TITLE_BLOCK")
  
  ' Build the selection set.
  '
  ssTitleBlock.Select Mode:=acSelectionSetAll, FilterType:=intData, FilterData:=varData
  
  ' Was anything actually found?
  '
  If ssTitleBlock.Count = 0 Then
    ' The title block wasn't found, notify the user and exit.
    '
    MsgBox "A Standard title block wasn't found, please correct and try again."
    End
  End If
  
  ' Collect the attributes.
  '
  varAttribs = AttribExtract(ssTitleBlock(0))
    
  ' Connect to the title block database.
  '
  Connect "<<Complete path and filename.mdb goes here>>", strTblName
  
  ' Walk the array and find the "Primary Key" field.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    If UCase(varAttribs(intAttribCnt).TagString) = "<<Tag string containing the primary key value>>" Then
      ' Now search for the existence of this record in the database
      ' and if there's a match, ask the user how to handle it.
      '
      strSearch = varAttribs(intAttribCnt).TextString
      Exit For
    End If
  Next intAttribCnt
  
  ' Now search the database, duplicate drawing numbers aren't allowed,
  ' if one is found, prompt the user how handle it.
  '
  rstAttribs.Find "<<Fieldname of primary key goes here (must be enclosed in square brackets ([]) >>= '" & strSearch & "'"
  
      ' For example using our database's primary key:
      '   
      ' rstAttribs.Find "[FileName] = '" & strSearch & "'"

  If rstAttribs.EOF Then
    blnDuplicate = False  ' No existing record found.
  Else
    blnDuplicate = True   ' Existing record found.
  End If
  
  If blnDuplicate Then
    ' Ask the user how to handle the duplicate.
    '
    result = MsgBox("A record with " & strSearch & " already exists, overwrite existing data?", vbQuestion + vbYesNo)
    If result = vbNo Then
      'User doesn't want to overwrite data, just end the routine.
      '
      GoTo ExportAttribs_Exit
    End If
  End If
      
  If Not blnDuplicate Then
    ' Record doesn't exist, add it.
    '
    rstAttribs.AddNew
  End If
 
  ' Walk the array, comparing tag strings to field names,
  ' and populating or updating accordingly.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    For Each fldAttribs In rstAttribs.Fields
      ' Does the tag string value match the field name?
      '
      If UCase(fldAttribs.Name) = UCase(varAttribs(intAttribCnt).TagString) Then
        ' Must have the corresponding tag string and field name,
        ' make sure the attribute is not blank, then update the field.
        '
	If len(fldAttribs.Value) > 0 Then
	  fldAttribs.Value = varAttribs(intAttribCnt).TextString
	End If
        Exit For
      End If
    Next fldAttribs
  Next intAttribCnt
   
  ' Commit the changes.
  '
  rstAttribs.Update

ExportAttribs_Exit:
  
  ' Now close out the recordset and connections
  '
  On Error Resume Next
  rstAttribs.Close
  cnnDataBse.Close
  
  rstAttribs = Nothing
  cnnDataBse = Nothing
  End

ExportAttribs_Error:
  MsgBox "Error: " & Err.Number & " - " & Err.Description
  Resume ExportAttribs_Exit
  
End Sub

To help make the code work with your company's information, I have embedded in the code some specific instructions for you to change. Simply perform a search for "<<" (no quotes) and your editor will place your cursor where you'll need to make changes for the routine to work with your information.

Once you've completed the above, you're now ready to test the routine. You can have Access open when you run the routine, but you cannot have the table open in "design mode" - you will generate an error and the routine will fail. There is very little error handling in this routine as it is just for demonstration so make sure you allow for this when you adapt it to your needs. If all goes well, you should have your information from your title block, now in your database!
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top