Update Attributes from MS Access

I'm looking for examples of Access VBA code or VB code that will update attributes in a drawing.

I have an Access database that contains the drawing filename and the attributes that I want to update in the TitleBlock (drawing number, title 1, title 2, title 3, etc). I would like to process the entire table by opening the drawing using the filename and update the attributes with the corresponding field names/attribute names.

Do Until rst.eof
Open autocad drawing file using filename
Update attribute values with data from database record
Update and close autocad drawing file
rst.movenext
Loop

Would 'Using Visual Basic with AutoCAD' be a good reference book?

Any pointers/assistance would be greatly appreciated.

Thanks,
Walter

 

hi walter,

do you only have one titleblock in a drawing? in case of usage of
layouts there could be more and that will give some irritation for
getting a exact reference between your drawing and your database.

if only one, you open the drawing, create a selectionset filtered to the
blockname of your tileblock (check if only one blockref is returned),
change attributes and save the drawing back.

- alfred -

 

Here's a piece of AutoCAD VBA code that updates attributes from an ADO
Recordset object. Look it over, then ask more questions.

--------------------------------------
' Update attributes w/ values from the table
Private Sub RSToAttribs(sTblName As String)
Dim oBlkRef As AcadBlockReference
Dim vAttribs As Variant, vAttrib As Variant
Dim sHandle As String, sTag As String, sPartID As String

' error handler removed
' moRSet is module level ADO Recordsetobject

If Not (moRSet.BOF And moRSet.EOF) Then ' recordset not empty
moRSet.MoveFirst
Do While Not moRSet.EOF
sHandle = moRSet!PRIMARY_KEY ' recover entity handle
sHandle = Right(sHandle, Len(sHandle) - Len(sTblName) - 1)
Set oBlkRef = ThisDrawing.HandleToObject(sHandle) ' get block ref
If oBlkRef.HasAttributes Then
vAttribs = oBlkRef.GetAttributes
If Not IsNull(moRSet!Layer) Then
oBlkRef.Layer = moRSet!Layer
End If
For Each vAttrib In vAttribs
Select Case oBlkRef.Name
Case "BOM1"
Select Case vAttrib.TagString
Case "TAG": vAttrib.TextString = IIf(IsNull(moRSet!Tag), "",
moRSet!Tag)
Case "QUANTITY": vAttrib.TextString =
IIf(IsNull(moRSet!USER1), "", moRSet!USER1)
Case "DESCRIPTION": vAttrib.TextString =
IIf(IsNull(moRSet!STORE_DESCRIPTION), "", Left(moRSet!STORE_DESCRIPTION,
giDescWidth))
Case "STORE_CODE": vAttrib.TextString =
IIf(IsNull(moRSet!NE_STORE_CODE), "", moRSet!NE_STORE_CODE)
Case "USER2": vAttrib.TextString = IIf(IsNull(moRSet!User2),
"", moRSet!User2) ' invisible attrib
End Select
Case "CU1"
Select Case vAttrib.TagString
Case "CU_NUMBER": vAttrib.TextString =
IIf(IsNull(moRSet!CU_Number), "", moRSet!CU_Number)
Case "TAG": vAttrib.TextString = IIf(IsNull(moRSet!Tag), "",
moRSet!Tag)
Case "QUANTITY": vAttrib.TextString =
IIf(IsNull(moRSet!USER1), "", moRSet!USER1)
Case "DESCRIPTION": vAttrib.TextString =
IIf(IsNull(moRSet!STORE_DESCRIPTION), "", Left(moRSet!STORE_DESCRIPTION,
giDescWidth))
Case "STORE_CODE": vAttrib.TextString =
IIf(IsNull(moRSet!NE_STORE_CODE), "", moRSet!NE_STORE_CODE)
Case "USER2": vAttrib.TextString = IIf(IsNull(moRSet!User2),
"", moRSet!User2) ' invisible attrib
End Select
Case Else ' process as a model part
Select Case vAttrib.TagString
' on 1st pass moRSet!Tag is Null
Case "TAG": vAttrib.TextString = IIf(IsNull(moRSet!Tag), "",
moRSet!Tag)
Case "DESCRIPTION": vAttrib.TextString =
IIf(IsNull(moRSet!STORE_DESCRIPTION), "", moRSet!STORE_DESCRIPTION)
Case "VENDOR": vAttrib.TextString =
IIf(IsNull(moRSet!Vendor), "", moRSet!Vendor)
Case "VENDOR_PART_ID": vAttrib.TextString =
IIf(IsNull(moRSet!Vendor_Part_ID), "", moRSet!Vendor_Part_ID)
Case "NG_STORE_CODE": vAttrib.TextString =
IIf(IsNull(moRSet!NG_Store_Code), "", moRSet!NG_Store_Code)
Case "NE_STORE_CODE": vAttrib.TextString =
IIf(IsNull(moRSet!NE_STORE_CODE), "", moRSet!NE_STORE_CODE)
Case "NM_STORE_CODE": vAttrib.TextString =
IIf(IsNull(moRSet!NM_Store_Code), "", moRSet!NM_Store_Code)
Case "CU_NUMBER": vAttrib.TextString =
IIf(IsNull(moRSet!CU_Number), "", moRSet!CU_Number)
Case "USER_1": vAttrib.TextString =
IIf(IsNull(moRSet!USER1), "", moRSet!USER1)
Case "USER_2": vAttrib.TextString =
IIf(IsNull(moRSet!User2), "", moRSet!User2)
End Select
End Select
Next vAttrib
Else
' ?Error msg
End If 'oBlkRef.HasAttributes
moRSet.MoveNext
Loop 'While Not moRSet.EOF
Else
'Error msg
End If ' recordset not empty

Exit_RSToAttribs:
Exit Sub

End Sub

--------------------------------------

--
John Goodfellow
irtfnm
use john at goodfellowassoc dot com

attributes that I want to update in the TitleBlock (drawing number, title 1,
title 2, title 3, etc). I would like to process the entire table by opening
the drawing using the filename and update the attributes with the
corresponding field names/attribute names.

 

Walter,

This is the third part of a series linking autocad with VBA
http://usa.autodesk.com/adsk/servlet/item?siteID=123112&id=3288443


Hope this helps
John Coon

 

Private Sub Command0_Click()
Dim acadapp As Object
Dim acDocument As Object

On Error Resume Next
Set acadapp = GetObject(, "AutoCAD.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.application")
End If


acDocument = acadapp.documents.Open("C:\1\attribute-test.dwg")
acadapp.Visible = True

Set acDocument = Nothing
Set acadapp = Nothing


Screen.PreviousControl.SetFocus
DoCmd.FindNext

Exit_Command0_Click:
Exit Sub

Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click

End Sub

John Coon