AtoCAD, Access and VBA
AtoCAD, Access and VBA
(OP)
I have a drawing with several tabs. Each tab is named to match a record in my database, i.e. tab “R001” and record “R001”. The layout of each tab contains several blocks, each with several attributes. Each attribute’s tag is named to match a field name in my database, i.e. tag “FLOOR_AREA” and field “FLOOR_AREA”.
I am trying to put together a VBA app that will determine the current tab name and change the values of the attributes based on the related database record. This information does not need to be saved in the drawing, in fact it would be preferable to have the data accessed ‘on-the-fly’ so that the data viewed is the most recent.
I have hardly any VBA experience so I'm struggling a bit. I've learned quite a lot today, but still really have no clue on where to start with the code. I'm assuming it should be fairly basic, but I could be very wrong.
Thanks,
Chris
I am trying to put together a VBA app that will determine the current tab name and change the values of the attributes based on the related database record. This information does not need to be saved in the drawing, in fact it would be preferable to have the data accessed ‘on-the-fly’ so that the data viewed is the most recent.
I have hardly any VBA experience so I'm struggling a bit. I've learned quite a lot today, but still really have no clue on where to start with the code. I'm assuming it should be fairly basic, but I could be very wrong.
Thanks,
Chris
RE: AtoCAD, Access and VBA
Have a look at FAQ687-5800: How to connect AutoCAD to Access that should get you going on how to pull your attribute information from your blocks.
The next piece, just walking the drawing tabs, would look something like this:
CODE
Dim oLayout As AcadLayout
For Each oLayout In ThisDrawing.Layouts
Debug.Print oLayout.Name
Next oLayout
End Sub
HTH
Todd
RE: AtoCAD, Access and VBA
RE: AtoCAD, Access and VBA
Yep. Instead of updating the recordset, you'll just need to read the recordset from Access, and then update the title block attributes.
Post back if you need more help.
HTH
Todd
RE: AtoCAD, Access and VBA
I tried the FAQ687-5800: How to connect AutoCAD to Access and its throwing back several errors. I have the title block in the drawing, then via VBAMAN load the DVB file I created, then via VBARUN I run the app. The following messages appear;
First, this error;
Error: -2147217887 - Index or primary key cannot contain null value.
Then this;
Error: 0 -
Then this;
Error: 20 - Resume without error.
Then it repeats errors 0 and 20 every time I click OK. I have to kill AutoCAD via the task manager and restert it.
I can see after going through the code that I can base my solution on it. I just need to get the basis of it working properly. I can upload my files if anyone can help?
RE: AtoCAD, Access and VBA
But with everything set up as per the FAQ except for paths, filenames, etc, I still receive an error;
Compile Error: Invalid use of property
It highlights one of the very last lines of 'Public Sub ExportAttribs()', the line being 'rstAttribs = Nothing'.
RE: AtoCAD, Access and VBA
Wow, that's a new one on me... For now, just comment it out, but it may need to read Set rstAttribs = Nothing
HTH
Todd
RE: AtoCAD, Access and VBA
I changed those two lines near the end to;
Set rstAttribs = Nothing
Set cnnDataBse = Nothing
which has fixed the error 'Compile Error: Invalid use of property'.
It now comes up with the following error;
Error: -2147217887 - Index or primary key cannot contain null value.
I will take a look and see if I can find out more abou that error number.
RE: AtoCAD, Access and VBA
I'll keep you posted on my progress.
RE: AtoCAD, Access and VBA
CODE
Public cnnDataBse As ADODB.Connection 'ADO connection to database.
Public rstAttribs As ADODB.Recordset 'ADO recordset to update.
Public Function vbdPowerSet(strName As String) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = ThisDrawing.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
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
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 Connect(strDatabase As String, strTableName As String)
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)
Dim vArray As Variant 'Attribute array.
If blkRef.HasAttributes Then
vArray = blkRef.GetAttributes
AttribExtract = vArray
End If
End Function
Public Sub ExportAttribs()
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, "TitleBlock", _
-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 "H:\Room Datasheets\TBLOCK2DB\DrawingDatabase.mdb", strTblName
' Walk the array and find the "Primary Key" field.
'
For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
If UCase(varAttribs(intAttribCnt).TagString) = "FILENAME" 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 "[FILENAME] = '" & 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
Set rstAttribs = Nothing
Set cnnDataBse = Nothing
End
ExportAttribs_Error:
MsgBox "Error: " & Err.Number & " - " & Err.Description
Resume ExportAttribs_Exit
End Sub
Am I right in thinking that all my modifications will take place in 'Public Sub ExportAttribs()' after the line that reads 'varAttribs = AttribExtract(ssTitleBlock(0))'? All I want to do is import the fields of a specific record to the attributes of a block.
RE: AtoCAD, Access and VBA
You are correct about what module to modify.
Your plan, if I understand what you need to accomplish, should be:
- Collect all the tab names in the drawing.
- Collect all the blocks you need to update on each tab
- Read the database and find any corresponding records, based on tab names.
- if found - update the blocks.
- if not found - add the information?
With this in mind, you may want to keep Export Attributes around to populate any missing data.HTH
Todd
RE: AtoCAD, Access and VBA
You are almost correct in what I want to achieve, of course my description becomes clearer the more I learn. All processes will be controlled from my access database, ie; a button press or other action. Command lines and scripts will then be passed to AutoCAD. So, for example;
- User enters a new record into database in access.
- User presses button marked 'Create datasheet'.
- Button script opens a predefined drawing in AutoCAD, creates a new tab named after the primary key of the current record in access.
- This VBA runs in AutoCAD performing the following;
- Finds the name of the current tab (the tab just created).
- Finds the record in the database with a primary key of the same name as the current tab.
- Imports the fields of that record to enter into the attributes of the block on the current tab.
Export is not needed. All data will be stored in the database and the AutoCAD drawing will only be used for output. If a record is not in the database, it should not exist in the drawing, so maybe delete the tab from the drawing if the corresponding database record is not found?I will also have a button somewhere in my database to update all the tabs in the drawing to match the records in the database, but I'll worry about that later since the basic functionality will become clear once I have this working.
RE: AtoCAD, Access and VBA
RE: AtoCAD, Access and VBA
I had a bit of a breakthrough and I have managed to get the script to import fields to the attributes, however, I am receiving a type mismatch error when trying to import from empty fields. How can I get around this and leave an attribute blank if the corresponding field has no data?
My code is as follows;
CODE
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, "TitleBlock", _
-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
' HERES WHERE I NEED TO FIND THE TAB NAME AND USE IT TO IDENTIFY WHICH RECORD TO IMPORT THE ATTRIBUTES FROM ******************
' Collect the attributes.
'
varAttribs = AttribExtract(ssTitleBlock(0))
' Connect to the title block database.
'
Connect "H:\Room Datasheets\TBLOCK2DB\DrawingDatabase.mdb", strTblName
' Walk the array and find the "Primary Key" field.
'
For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
If UCase(varAttribs(intAttribCnt).TagString) = "FILENAME" Then
strSearch = varAttribs(intAttribCnt).TextString
Exit For
End If
Next intAttribCnt
' HERES WHERE I CHECK TO SEE IF THE RECORD EXISTS ****************************************************************************
' Now search the database, duplicate drawing numbers aren't allowed,
' if one is found, prompt the user how handle it.
'
rstAttribs.Find "[FILENAME] = '" & strSearch & "'"
' For example using the 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 Not blnDuplicate Then
' Record doesn't exist, inform user.
'
result = MsgBox("Record not found")
End If
' HERES WHERE I NEED TO IMPORT FIELDS TO THE ATTRIBUTES **********************************************************************
' 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,
' then update the field.
'
varAttribs(intAttribCnt).TextString = fldAttribs.Value
Exit For
End If
Next fldAttribs
Next intAttribCnt
' Commit the changes.
'
rstAttribs.Update
' EXIT THE DATABASE **********************************************************************************************************
ExportAttribs_Exit:
' Now close out the recordset and connections
'
On Error Resume Next
rstAttribs.Close
cnnDataBse.Close
Set rstAttribs = Nothing
Set cnnDataBse = Nothing
End
ExportAttribs_Error:
MsgBox "Bollocks! Error " & Err.Number & " - " & Err.Description
Resume ExportAttribs_Exit
End Sub
RE: AtoCAD, Access and VBA
Try something along the lines of:
CODE
' Must have the corresponding tag string and field name,
' then update the field.
'
varAttribs(intAttribCnt).TextString = fldAttribs.Value
Exit For
End If
HTH
Todd
RE: AtoCAD, Access and VBA
Thanks for the code snippet Todd. It came in handy and I can now delete a field in a record in the database, and have the appropriate attribute blanked in AutoCAD. The code I now have is as follows;
CODE
' 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) And Not IsNull(fldAttribs.Value) Then
' Must have the corresponding tag string and field name,
' then update the field.
'
fldFull = True
Else
fldFull = False
End If
If Not fldFull Then
varAttribs(intAttribCnt).TextString = ""
Else
varAttribs(intAttribCnt).TextString = fldAttribs.Value
Exit For
End If
Next fldAttribs
Next intAttribCnt
' Commit the changes.
'
rstAttribs.Update
My drawing will have multiple layouts. I now need to add to the script so it will do the following;
- determine the name of the current layout.
- find the corresponding record in the database (layout name will also be primary key).
- update the block on that layout from the record in the database.
I have found the following script which I may be able to use as the basis of a new subroutine;CODE
Dim fType(0 To 1) As Integer, fData(0 To 1)
Dim DataSS As AcadSelectionSet
Dim dwgEnt As AcadEntity
Dim adLayout As AcadLayout
Dim itemType As String
Dim itemCount As Integer
On Error Resume Next
'first create a selection set of all items of the type you want to work with
Set DataSS = ThisDrawing.SelectionSets("DataSS")
If Err Then Set DataSS = ThisDrawing.SelectionSets.Add("DataSS")
DataSS.Clear
itemType = "TEXT" 'this holds the type of entity we'll be collecting
fType(0) = 0: fData(0) = itemType
fType(1) = 8: fData(1) = "*" 'Here you specify the layer. We'll use all layers
DataSS.Select acSelectionSetAll, , , fType, fData
'now we cycle through all the layouts
For Each adLayout In ThisDrawing.Layouts
itemCount = 0
ThisDrawing.ActiveLayout = adLayout
For Each dwgEnt In DataSS
'this is where the items residing on the current layout are culled
If LCase(ThisDrawing.ObjectIdToObject(dwgEnt.OwnerID).Layout.Name) = LCase(adLayout.Name) Then
itemCount = itemCount + 1
End If
Next dwgEnt
MsgBox "Report for " & itemType & " Entities-" & vbCrLf & _
"Total in the active drawing: " & DataSS.Count & vbCrLf & _
"Total on layout " & adLayout.Name & ": " & itemCount
Next adLayout
DataSS.Delete
End Sub
Am I barking up the wrong tree? Is is a simple case of appending references to the block with 'ThisDrawing.ActiveLayout'?
RE: AtoCAD, Access and VBA
This line should do it:
CODE
Just add the active layout name to your search criteria:
CODE
' Now search the database, duplicate drawing numbers aren't allowed,
' if one is found, prompt the user how handle it.
'
rstAttribs.Find "[FILENAME] = '" & strSearch & "' AND [LAYOUT] = '" & strLayoutName & "'"
' For example using the 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 Not blnDuplicate Then
' Record doesn't exist, inform user.
'
result = MsgBox("Record not found")
End If
You've already got that part. So, yes the code you posted could easily be modified to do what you want. Looks like you're on your way!
HTH
Todd
RE: AtoCAD, Access and VBA
Thank you very much for all the help you are giving me.
I have now made the following changes;
CODE
strTblName = "tblDrawings" ' Table name in database.
strLayoutName = ThisDrawing.ActiveLayout.Name ' Current layout name
Set AcadDoc = ThisDrawing ' Current drawing.
CODE
So the script is now using the record with the primary key that matches the layout name, which is correct. However, when it imports the fields from the database, it will only update the block that resides on the first layout. So if I go to 'layout002' and run the script, it imports the correct record, but updates the block on 'layout001' instead. How do I update the block on the current layout?
RE: AtoCAD, Access and VBA
It sounds like you still have a selection set in memory. You'll need to make your layout current and then select your blocks, or modify the selection set filter codes to select only blocks residing on a particular layout.
HTH
Todd
RE: AtoCAD, Access and VBA
So I must have to modify the selection set filter codes to select only blocks residing on the current layout. I have no idea where to start :(
A quick google didn't seem very helpful either.
RE: AtoCAD, Access and VBA
RE: AtoCAD, Access and VBA
After a little experimenting - you are right the 410 code doesn't work. However, in your case since you have a paperspace tab active already, this will work:
CODE
0, "INSERT", _
2, "TitleBlock", _
67, 0, _
-4, "and>"
Just remember, it will only select the blocks named "TitleBlock" in paperspace on the ACTIVE LAYOUT only - it won't work in batch mode per se. If you need that, you'll need to walk the collection of tabs, set each one current, and then run the selection set.
HTH
Todd
RE: AtoCAD, Access and VBA
After looking around I think whats needed is a routine of some sort to filter the selection set. Something like;
- Send selection set to array
- Purge blocks not on the current layout from the array
- Import attributes to the remaining block in the array
Would something like that work?RE: AtoCAD, Access and VBA
CODE
Dim b As AcadBlockReference
Id = ThisDrawing.PaperSpace.ObjectID
For Each b In ssTitleBlock
Debug.Print b.OwnerID
If b.OwnerID = Id Then
yadayada
Is that workable?
RE: AtoCAD, Access and VBA
You are correct it won't select anything in modelspace with a code 67 . 0 - your first layout is usually model space. I tried the response you received from another forum before I posted the above code and the OwnerID returned for block references (inserted blocks) is the block table record. So, no, it's not workable.
You may need to have some user interaction, or if your intial selection set count is zero, change the filter criteria and re-run the selection set again.
HTH
Todd
RE: AtoCAD, Access and VBA
Where did you go??
Todd
RE: AtoCAD, Access and VBA
RE: AtoCAD, Access and VBA
Currently (at least up 2007) there is not. You would need to use uniquely named blocks. There may be a way in 2008.
HTH
Todd
RE: AtoCAD, Access and VBA
RE: AtoCAD, Access and VBA
I gave on on layout filtering in the end and instead decided to create a new layer named the same as the layout on which the block resides to filter by. A bit messier than I wanted but it does the job.
Chris.
RE: AtoCAD, Access and VBA
Glad you could make it work!
Todd