Public Sub ImportAttribs()
'
' Title : ImportAttribs
'
' Version : 1.0.0
' Author(s) : Todd Carpenter
' Created : 04/15/2005 08:13:55 AM
' Last Edit : 04/15/2005 08:13:55 AM, TDC
' Copyright : (c)2005 Todd Carpenter
'
' Description:
' ¯¯¯¯¯¯¯¯¯¯¯¯
' This routine is used to update or import attribute
' values from a database.
'
' 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:
' ¯¯¯¯¯¯¯¯
' 04/15/2005 08:13:55 AM - 1.0.0 - TDC
' 1) Initially created
'
' Future considerations:
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' 1) None
'
' ImportAttribs 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 result As VbMsgBoxResult 'User prompted responses.
Dim strTblName As String 'Name of Access table to populate.
' Defaults.
'
strTblName = "toddiscool"
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:\Autocad\database.mdb", strTblName
' Walk the array and find the "Primary Key" field: DWGNUM
'
strSearch = ThisDrawing.Path & "\" & ThisDrawing.Name
' Now search the database, and locate the record to import.
'
rstAttribs.Find "[Locatie bestand]= '" & strSearch & "'"
If rstAttribs.EOF Then
' blnDuplicate = False ' No existing record found.
MsgBox "No records found to update. Please check the database and try again."
Exit Sub
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.
'
varAttribs(intAttribCnt).TextString = fldAttribs.Value
Exit For
End If
Next fldAttribs
Next intAttribCnt
ssTitleBlock(0).Update
'-----------------------------------------------------------------------------------
AcadDoc.Plot.NumberOfCopies = "[Aantal]"
AcadDoc.Plot.PlotToDevice
'AcadDoc.Save
'AcadApplication.Quit
End Sub
))