CADForums.net

wmsnh · Guest

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

Alfred NESWADBA · Guest

In article
<19770058.1103165766977.JavaMail.jive@jiveforum1.autodesk.com>,
nospam@address.withheld says...

John Goodfellow · Guest

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

"wmsnh" <nospam@address.withheld> wrote in message
news:19770058.1103165766977.JavaMail.jive@jiveforum1.autodesk.com...

john coon · Guest

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

"Jon Fleming" <jonf@fleming-group.com> wrote in message
news:VA.00001484.02eec033@fleming-group.com...

John Coon · Guest

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
"john coon" <jcoon@hta-nh.com> wrote in message
news:41c326ea$1_3@newsprd01...

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1