Link between AutoCad and Access 2

[HanKleppe]

Hi,

I'm a newbie on this forum.

The case:

In our company we use AutoCad2004 and Access97. I want to set up a link between this two.

We have over 3000 drawings (in *.DWG format). The drawer makes some blocks below the drawing with some variable information.

Now I wanna link this information with Access. I've tried it with DBManager but there not a lot information about this. The form must be something like this:

Who can help me in the next steps?

Many thanks in forward!

 

[TCARPENTER]

Hi HanKleppe,

I can help with this. You'll need to know two things: the name of the tagstrings within your titleblock and the field names in Access to which they relate. For example, your block may have an attribute with a tag named "TITLE1", and in your database this would belong in a field named Drawing_Description (note the field name and the caption are not always the same so make sure you check). Once you have that figured out, I'll show you how to plug that into a small chunk of VBA code to get the job done.

Todd

 

[HanKleppe]

Hi TCARPENTER

Thanks for the reply!
Sorry for my bad English, my Dutch is better

At the moment I've no database, i'm gonna make it when I have the structure.
See below for the tagstrings:

Han

 

[TCARPENTER]

Ok this is pretty easy then. First you'll need to create your database and most people just use the same tag names from their attributes to name their fields. So your table structure would look something like this:

tblDrawings
[li]ART[/li]
[li]DAT1[/li]
[li]DAT2[/li]
[li]DAT3[/li]
[li]OMS[/li]
[li]...[/li]

Now, something to keep in mind when you do this is to use a primary key. A primary key can be any one of the fields you have listed with the exception it cannot have duplicate data. If you are tracking the file name with the rest of the data (which makes good sense) this is the perfect "Primary Key". Just as you cannot have duplicate file names in the same directory, you cannot have duplicate filenames in the same database table.

Next, you'll need to write some code to "talk" to the database. My preference for this is ADO. You can use DAO also if you wish, your choice.

How much VB/VBA do you know?

Let me know when you've got your database built.

Todd

 

[HanKleppe]

Todd,

I've used the filename as the primary-key.

The tabel contains 12 fields:

(note the image is changed, was the wrong drawing)

- file name (text) (primary key)
- oms (text)
- art (number)
- mat (text)
- opp (text)
- hard (text)
- get (text)
- een (text)
- sch (text)
- for (text)
- pos (number)
- aanmaak datum (date)
- rev dat (date)

It's doesnt matter which language you use for communicating, what you want

I know a little VB/VBA

Thanks!

ps Is it possible when we're ready with the structure that the database reads the data out autocad? Else it cost me many time to type over the variables of 3000 drawings

 

[TCARPENTER]

Hi Han,

To be honest I thought that was what your were looking for in the first place!

Since you know a little VBA, start your VBA editor from AutoCAD and go to the Tools->References... pulldown. In the dialog box that opens, search and select a reference to "Microsoft ActiveX Data Object 2.x Library" where the x represent either 0 through 8 (if you have multiple versions, I usually go with the latest - note you can only check one - other wise you will generate an error. Now, copy and paste the following code in the section labled ThisDrawing:

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.

Public Sub ExportAttribs()
  '
  ' Title     : ExportAttribs
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 11:57:39 AM
  ' Last Edit : 03/04/2005 11:57:39 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' 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) AcadDoc    - Current AutoCAD drawing document must be global.
  '      2) cnnDataBse - Connection to database must be global.
  '      3) rstAttribs - Recordset to update or append to database, must be global.
  '
  '
  ' 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 containing the title block to export.
  Dim intData()    As Integer           'DXF integer code used to filter selection set.
  Dim varData()    As Variant           'DXF code description used to filter selection set.
  Dim varAttribs   As Variant           'Attribute array from title block.
  Dim intAttribCnt As Integer           'Attribute array upper and lower bounds.
  Dim fldAttribs   As ADODB.Field       'ADO fields from recordset for populating recordset.
  Dim strSearch    As String            'Pseudo Primary Key in case of duplicates.
  Dim blnDuplicate As Boolean           'Flag indicating a duplicate record has been found.
  Dim result       As VbMsgBoxResult    'User prompted responses.
  Dim strTblName   As String            'Name of Access table to populate.

  ' Defaults.
  '
  strTblName = <<Name of table to populate>>
  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("TBLOCK")
  
  ' 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: DWGNUM
  '
  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 & "'"
  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.
      '
      End
    Else
      result = MsgBox("Are you sure you want to overwrite " & strSearch & "?" & vbCrLf & vbCrLf & _
                      "Changes cannot be undone.", vbQuestion + vbYesNo)
    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 right tag string mapped to the correct field name,
        ' update the field.
        '
        fldAttribs.value = varAttribs(intAttribCnt).TextString
        Exit For
      End If
    Next fldAttribs
  Next intAttribCnt
   
  ' Commit the changes.
  '
  rstAttribs.Update
    
End Function
Public Function Connect(strDatabase As String, strTableName As String)
  '
  ' Title     : Connect
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 08:57:36 AM
  ' Last Edit : 03/04/2005 08:57:36 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This function is used to connect to an
  '   ADO recordsource.
  '
  ' 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 "C:\TCARPENTER\VB\BAAMOLD\Dwg mastertest.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

Public Function AttribExtract(blkRef As AcadBlockReference)
  '
  ' Title     : AttribExtract
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 08:49:24 AM
  ' Last Edit : 03/04/2005 08:49:24 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' 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
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
  '
  ' Title     : BuildFilter
  '
  ' Version   : ?.?.?
  ' Author(s) : Frank Oquendo
  ' Created   : 03/20/2002 11:17:43 AM
  ' Last Edit : 03/20/2002 11:17:43 AM, TDC
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This routine is used to fill a pair of variants
  '   with arrays for use as a selection set filter.
  '
  ' Additional files/functions required:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '   1) None
  '
  ' Requires the following variables:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    * Input assignments
  '      1) typeArray - An integer array of DXF codes.
  '      2) dataArray - A Variant array of DXF code descriptions.
  '
  ' Example usage:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    BuildFilter intData, varData, -4, "<and", _
  '                                     0, "INSERT", _
  '                                     2, "TB*", _
  '                                  -4, "and>"
  '
  ' Updates:
  ' ¯¯¯¯¯¯¯¯
  ' 03/20/2002 11:17:43 AM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    1) None
  '
  ' BuildFilter begins here:
  ' ——————————————————————————————————————————————————

  Dim fType() As Integer, fData()
  Dim index As Long, i As Long
   
  index = LBound(gCodes) - 1
        
  For i = LBound(gCodes) To UBound(gCodes) Step 2
      index = index + 1
      ReDim Preserve fType(0 To index)
      ReDim Preserve fData(0 To index)
      fType(index) = CInt(gCodes(i))
      fData(index) = gCodes(i + 1)
  Next
 
 typeArray = fType: dataArray = fData

End Sub

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
  '
  ' Title     : vbdPowerSet
  '
  ' Version   : 1.0.0
  ' Author(s) : Randall Rath
  ' Created   : 03/20/2002 01:45:37 PM
  ' Last Edit : 03/20/2002 01:45:37 PM, TDC
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This function to add a new selection set by name, and check
  '   for an existing selection set.
  '
  ' Additional files/functions required:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '   1) None
  '
  ' Example usage:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    Set ssTitleBlocks = vbdPowerSet("TITLEBLOCKS_SSET")
  '
  ' Requires the following variables:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    * Input assignments
  '      1) strName - A string for any named sets within the
  '                   drawing for vbdPowerSet to search.
  '
  ' Updates:
  ' ¯¯¯¯¯¯¯¯
  ' 03/20/2002 01:45:37 PM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    1) None
  '
  ' vbdPowerSet begins here:
  ' ——————————————————————————————————————————————————

  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Set objSelCol = AcadDoc.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelCol.Item(strName).Delete
        Exit For
      End If
    Next
  Set objSelSet = objSelCol.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

Now, the code won't work as supplied. Do a search for "<<" each one of these (there are three or four) contain information you must supply. Correct these to items to read as they should, and then this portion of code should be almost ready to run.

The final step in this process is to connect it to a menu item, toolbar button or quick lisp routine.

To execute it from a button use the following syntax:

(command "_-vbarun" "ExportAttribs")

To load it so you'll have it all the time, place the macro in the acad.dvb file - this way the routine is loaded everytime AutoCAD loads a drawing.

Let me know how you make out!
HTH
Todd

 

[HanKleppe]

wow, that's looks very attracting!!! Thanks a lot!


I'm gonna implent (hope this is the right word ) your code.

 

[HanKleppe]

hi Todd,

When i run the script a "expected end sub" message appear. The button moves automatically to the ##@## below

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 right tag string mapped to the correct field name,
' update the field.
'
fldAttribs.Value = varAttribs(intAttribCnt).TextString
Exit For
End If
Next fldAttribs
Next intAttribCnt

' Commit the changes.
'
rstAttribs.Update

##@##
End Function

 

[TCARPENTER]

Oops,

Sorry I goofed, the line End Function should read End Sub

HTH
Todd

 

[HanKleppe]

Hello Todd,

i'm trying to run your script but there is a runtime error '-2147217900 (80040e14)': De component FROM bevat een syntaxisfout (in English, the component FROM contains an syntaxisbug)

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.

Public Sub ExportAttribs()
  '
  ' Title     : ExportAttribs
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 11:57:39 AM
  ' Last Edit : 03/04/2005 11:57:39 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' 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) AcadDoc    - Current AutoCAD drawing document must be global.
  '      2) cnnDataBse - Connection to database must be global.
  '      3) rstAttribs - Recordset to update or append to database, must be global.
  '
  '
  ' 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 containing the title block to export.
  Dim intData()    As Integer           'DXF integer code used to filter selection set.
  Dim varData()    As Variant           'DXF code description used to filter selection set.
  Dim varAttribs   As Variant           'Attribute array from title block.
  Dim intAttribCnt As Integer           'Attribute array upper and lower bounds.
  Dim fldAttribs   As ADODB.Field       'ADO fields from recordset for populating recordset.
  Dim strSearch    As String            'Pseudo Primary Key in case of duplicates.
  Dim blnDuplicate As Boolean           'Flag indicating a duplicate record has been found.
  Dim result       As VbMsgBoxResult    'User prompted responses.
  Dim strTblName   As String            'Name of Access table to populate.

  ' Defaults.
  '
  strTblName = Tabel
  Set AcadDoc = ThisDrawing ' Current drawing.
      
  ' Build the filter criteria.
  '
  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "Terrier kader", _
                                -4, "and>"
                                
  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("TBLOCK")
  
  ' 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 "C:\Documents and Settings\terrier.TERRIERCLAMPS\Bureaublad\Testcase Access Autocad\database.mdb", strTblName
  
  ' Walk the array and find the "Primary Key" field: DWGNUM
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    If UCase(varAttribs(intAttribCnt).TagString) = "Locatie bestand" 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 "[C:\Documents and Settings\terrier.TERRIERCLAMPS\Bureaublad\Testcase Access Autocad]= '" & 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.
      '
      End
    Else
      result = MsgBox("Are you sure you want to overwrite " & strSearch & "?" & vbCrLf & vbCrLf & _
                      "Changes cannot be undone.", vbQuestion + vbYesNo)
    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 right tag string mapped to the correct field name,
        ' update the field.
        '
        fldAttribs.Value = varAttribs(intAttribCnt).TextString
        Exit For
      End If
    Next fldAttribs
  Next intAttribCnt
   
  ' Commit the changes.
  '
  rstAttribs.Update
    
End Sub
Public Function Connect(strDatabase As String, strTableName As String)
  '
  ' Title     : Connect
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 08:57:36 AM
  ' Last Edit : 03/04/2005 08:57:36 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This function is used to connect to an
  '   ADO recordsource.
  '
  ' 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 "C:\TCARPENTER\VB\BAAMOLD\Dwg mastertest.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

Public Function AttribExtract(blkRef As AcadBlockReference)
  '
  ' Title     : AttribExtract
  '
  ' Version   : 1.0.0
  ' Author(s) : Todd Carpenter
  ' Created   : 03/04/2005 08:49:24 AM
  ' Last Edit : 03/04/2005 08:49:24 AM, TDC
  ' Copyright : (c)2005 Todd Carpenter
  '
  ' 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
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
  '
  ' Title     : BuildFilter
  '
  ' Version   : ?.?.?
  ' Author(s) : Frank Oquendo
  ' Created   : 03/20/2002 11:17:43 AM
  ' Last Edit : 03/20/2002 11:17:43 AM, TDC
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This routine is used to fill a pair of variants
  '   with arrays for use as a selection set filter.
  '
  ' Additional files/functions required:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '   1) None
  '
  ' Requires the following variables:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    * Input assignments
  '      1) typeArray - An integer array of DXF codes.
  '      2) dataArray - A Variant array of DXF code descriptions.
  '
  ' Example usage:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    BuildFilter intData, varData, -4, "<and", _
  '                                     0, "INSERT", _
  '                                     2, "TB*", _
  '                                  -4, "and>"
  '
  ' Updates:
  ' ¯¯¯¯¯¯¯¯
  ' 03/20/2002 11:17:43 AM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    1) None
  '
  ' BuildFilter begins here:
  ' ——————————————————————————————————————————————————

  Dim fType() As Integer, fData()
  Dim index As Long, i As Long
   
  index = LBound(gCodes) - 1
        
  For i = LBound(gCodes) To UBound(gCodes) Step 2
      index = index + 1
      ReDim Preserve fType(0 To index)
      ReDim Preserve fData(0 To index)
      fType(index) = CInt(gCodes(i))
      fData(index) = gCodes(i + 1)
  Next
 
 typeArray = fType: dataArray = fData

End Sub

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
  '
  ' Title     : vbdPowerSet
  '
  ' Version   : 1.0.0
  ' Author(s) : Randall Rath
  ' Created   : 03/20/2002 01:45:37 PM
  ' Last Edit : 03/20/2002 01:45:37 PM, TDC
  '
  ' Description:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯
  '   This function to add a new selection set by name, and check
  '   for an existing selection set.
  '
  ' Additional files/functions required:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '   1) None
  '
  ' Example usage:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    Set ssTitleBlocks = vbdPowerSet("TITLEBLOCKS_SSET")
  '
  ' Requires the following variables:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    * Input assignments
  '      1) strName - A string for any named sets within the
  '                   drawing for vbdPowerSet to search.
  '
  ' Updates:
  ' ¯¯¯¯¯¯¯¯
  ' 03/20/2002 01:45:37 PM - 1.0.0 - TDC
  '    1) Initially created
  '
  ' Future considerations:
  ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  '    1) None
  '
  ' vbdPowerSet begins here:
  ' ——————————————————————————————————————————————————

  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Set objSelCol = AcadDoc.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelCol.Item(strName).Delete
        Exit For
      End If
    Next
  Set objSelSet = objSelCol.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

I search on internet but i get find the solution. What i'm doing wrong?

Many thanks in forward!

 

[TCARPENTER]

Hi Han,

Check the spelling of the table "Tabel", if it's correct, you'll probably want to change the name of your table in Access because "Table" (English version) is a reserved word in SQL (meaning I can't use that name for anything other what it is specifically designed for), and maybe "Tabel" in your version (Dutch?) is probably a reserved word. This is probably why you are generating an error.

HTH
Todd

 

[HanKleppe]

Hi Todd,

Thank you for your quick reply! Yes, Tabel is Dutch for Table. I'm gonna change the names.

Gr,

Han

ps1 what is:
HTH

HTH
Todd

ps2 where are you from?

 

[HanKleppe]

Hi Todd,

I changed both names in "toddiscool" , but i still get the same error.

Maybe is this sentence wrong??

strSQL = "SELECT * FROM [" & strTableName & "]"

That's the only sentence where the word FROM is in...

Gr,
Han

 

[TCARPENTER]

Hi Han,

HTH = Hope That (or This) Helps

I'm in the Detroit Michigan area - just outside Detroit actually.

Do a debug.print statement on the strSQL it should read "SELECT * FROM [toddiscool]" (no quotes). If that's reading right, then I think maybe we have a problem with language barrier. In your version of Access, go to the query section of the database. Click new query and you should then be looking at the query builder. Select your renamed table from the "Show Tables" dialog box, then press "Add", and then close the dialog box. Right click in the open area above the gridded area and select "Properties..." In the dialog box that opens, find the line "Output All Fields" and make sure this says Yes. Then close this dialog box. Press either the button with the exclamation point (!) or the button under view which looks like a small spread sheet. We don't really care if nothing is returned, we just want to make sure we don't generate any errors. If you didn't get any errors, press the button with blue triangle icon on it to place the query back into design mode. That same button should have a dropdown arrow next to it. When you select that button (the drop down arrow) you should have a button labled SQL. Press this button. You should now see the query we've just created in a pure text or SQL form. The query should read something like SELECT * FROM toddiscool; in any case, you'll probably need to substitute what this query says for the query in your program. Let me know if have any trouble or if I've left anything out.

HTH
Todd

 

[HanKleppe]

Hi Todd,

[offtopic]
Cool, I've been in Detroit-airport. Then I went to Kalamazoo for a holiday.
[/offtopic]

I did what you said and I get this in Access:

SELECT *
FROM toddiscool;

So i tried it to change it in the text at several ways but no good result.

Actually I get with the following code this error:

strSQL = "SELECT * FROM toddiscool;"

Can't find the item in the collection that equals with the good name or number

--

You told me in the beginning that I have to change some variables which are inside <<>>
Maybe is here the error?

old

  ' Defaults.
  '
  strTblName = <<Name of table to populate>>
  Set AcadDoc = ThisDrawing ' Current drawing.

new

  ' Defaults.
  '
  strTblName = toddiscool
  Set AcadDoc = ThisDrawing ' Current drawing.

-------------------------------------------------
old

  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "<<Name of Title block goes here>>", _
                                -4, "and>"

new

  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "Terrier kader", _
                                -4, "and>"

-------------------------------------------------
old

  ' Connect to the title block database.
  '
  Connect "<<Complete path and filename.mdb goes here>>", strTblName

new

  ' Connect to the title block database.
  '
  Connect "C:\Documents and Settings\terrier.TERRIERCLAMPS\Bureaublad\Testcase Access Autocad\database.mdb", strTblName

-------------------------------------------------
old

If UCase(varAttribs(intAttribCnt).TagString) = "<<Tag string containing the primary key value>>" Then

new

If UCase(varAttribs(intAttribCnt).TagString) = "Locatie bestand" Then

-------------------------------------------------
old

rstAttribs.Find "<<Fieldname of primary key goes here (must be enclosed in square brackets ([]) >>= '" & strSearch & "'"

new

 rstAttribs.Find "[C:\Documents and Settings\terrier.TERRIERCLAMPS\Bureaublad\Testcase Access Autocad]= '" & strSearch & "'"

Hope this helps

Gr,

Han

 

[TCARPENTER]

Hi Han,

Ok, the original SQL text will work - you'll probably want to change it back to the way it was. The problem is in the following lines of code:

This line is missing the quotation marks and should read:

  ' Defaults.
  '
  strTblName = [red][b]"[/b][/red]toddiscool[red][b]"[/b][/red]

And this line should only have the field name - not the entire database location string:

rstAttribs.Find "[[red][b]file name[/b][/red]]= '" & strSearch & "'"

Funny you went to Kalamazoo - I used to live near there and have a sister-in-law who we didn't think would ever graduate from Western Michcigan University!

Anyway - let me know how you make out.
Todd

 

[HanKleppe]

Hi Todd,

Lol, the world is a small village. My uncle owns a factory: "Midwest Fasteners" in Kalamazoo.
Ever heard about it? (

http://www.fastenerconnection.com)

And this line should only have the field name - not the entire database location string:

rstAttribs.Find "[file name]= '" & strSearch & "'"

can you give an example of it?
I tried the *.dwg filename but it's still the same error.

Is this the correct code?

strSQL = "SELECT * FROM [" & strTableName & "]"

 

[TCARPENTER]

Hi Han,

As a matter of fact I have, I've probably bought thousands of dollars worth of fasteners from Midwest over the years from my local hardware stores....

Have you changed the structure of your table within your database?

I've used the filename as the primary-key.

The tabel contains 12 fields:

(note the image is changed, was the wrong drawing)

- file name (text) (primary key)
- oms (text)
- art (number)
- mat (text)
- opp (text)
- hard (text)
- get (text)
- een (text)
- sch (text)
- for (text)
- pos (number)
- aanmaak datum (date)
- rev dat (date)

If not, you should be able to just copy and paste:

rstAttribs.Find "[file name]= '" & strSearch & "'"

If you have, just change "[file name]" to whatever field you used for your primary key. If this doesn't make sense, post the design of your table.

Todd

 

[HanKleppe]

haha lol! It's a really small world.

I didn't change the name of the primaryfield. But I thought you mean file name like this: c:\etc... )

I think we make a step forward, it connects to the database.
Now i get a several errors:

The .Hard & .Mat are empty in the drawing so i change the name of the titles.

Now an error appears:

An Index or Primary key can't contain a Null-value

But we make a step forward!!!

Thanks,

Han

 

[TCARPENTER]

Hi Han,

Now we need to make sure your Attribute names match your field names. This line concerns me:

For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    If UCase(varAttribs(intAttribCnt).TagString) = [red]"Locatie bestand"[/red] 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

The portion in red, should not be a attribute tag string in your drawing, but it sould also match a field name in your database.

The other thing to check is in your table, make sure any fields you have as an index, are never empty in your title blocks. If you know you will not always have these fields filled in, then change them in your database so they are not indexed.

Todd