I have a routine that I copied off of the Autodesk NG from a few years back. I have tweaked it to work almost exactly as I need. One problem I have is if I delete an object from the acad drawing, it is still referenced in the access database. What I want to do is delete all the records in the table that match the current drawing name. I have looked for help elsewhere on this, but I dont quite understand the concept of records yet. I know this routine is written to work in autocad, but I just need help with the access record, everything autocad I have figured out. Could any one help fill in the blank to finish my code?
Public Sub PushToAccess()
Dim SchedApp As New AecScheduleApplication
Dim cPropSets As AecSchedulePropertySets
Dim PropSet As AecSchedulePropertySet
Dim cProps As AecScheduleProperties
Dim Prop As AecScheduleProperty
Dim space As AecSpace
Dim obj As AcadEntity
Dim cat As New ADOX.Catalog
Dim cnn As New ADODB.Connection
Dim fso As New FileSystemObject
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=I:\Facilities\Facilities Database\Facilities Utilization.mdb"
Set cat.ActiveConnection = cnn
Dim spaceTbl As New ADOX.Table
Dim sTable As String
Dim bFoundTable As Boolean
sTable = Mid(ThisDrawing.GetVariable("dwgname"), 1, 3)
bFoundTable = False
For Each spaceTbl In cat.Tables
If UCase(spaceTbl.Name) = UCase(sTable) Then
bFoundTable = True
Exit For
End If
Next
If bFoundTable Then
'''Delete all records in the table that matches sTable whoes field, DrawingName, matches dwgname
'I currently have the next line in here, but that deletes everything, including the table.
cat.Tables.Delete sTable
End If
With spaceTbl
.Name = sTable
.Columns.Append "Handle"
.Columns.Append "RoomNumber"
.Columns.Append "RoomName"
.Columns.Append "Area"
.Columns.Append "Style"
.Columns("RoomNumber").Attributes = adColNullable
.Columns("RoomName").Attributes = adColNullable
.Columns("Area").Attributes = adColNullable
.Columns("Style").Attributes = adColNullable
Dim index As New ADOX.index
index.Name = "Handle"
index.Columns.Append "Handle"
index.Unique = True
index.PrimaryKey = True
spaceTbl.Indexes.Append index
cat.Tables.Append spaceTbl
Set cnn = cat.ActiveConnection
End With
Dim spaceRs As New ADODB.Recordset
spaceRs.Open sTable, cnn, adOpenKeyset, adLockOptimistic
For Each obj In ThisDrawing.ModelSpace
If TypeOf obj Is AecSpace Then
Set space = obj
Set cPropSets = SchedApp.PropertySets(space)
Set PropSet = cPropSets.Item("SpaceObjects")
If Not PropSet Is Nothing Then
Set cProps = PropSet.Properties
spaceRs.Find "Handle = '" & space.Handle & "'"
If spaceRs.EOF Then
spaceRs.AddNew
spaceRs!Handle = space.Handle
End If
spaceRs!Area = cProps.Item("BaseArea").value
spaceRs!Style = cProps.Item("Style").value
spaceRs.Update
End If
Set PropSet = cPropSets.Item("RoomObjects")
If Not PropSet Is Nothing Then
Set cProps = PropSet.Properties
spaceRs.Find "Handle = '" & space.Handle & "'"
If spaceRs.EOF Then
spaceRs.AddNew
spaceRs!Handle = space.Handle
End If
spaceRs!RoomNumber = cProps.Item("Number").value
spaceRs!RoomName = cProps.Item("Name").value
spaceRs.Update
End If
End If
Next
Set cat = Nothing
End Sub
Public Sub PushToAccess()
Dim SchedApp As New AecScheduleApplication
Dim cPropSets As AecSchedulePropertySets
Dim PropSet As AecSchedulePropertySet
Dim cProps As AecScheduleProperties
Dim Prop As AecScheduleProperty
Dim space As AecSpace
Dim obj As AcadEntity
Dim cat As New ADOX.Catalog
Dim cnn As New ADODB.Connection
Dim fso As New FileSystemObject
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=I:\Facilities\Facilities Database\Facilities Utilization.mdb"
Set cat.ActiveConnection = cnn
Dim spaceTbl As New ADOX.Table
Dim sTable As String
Dim bFoundTable As Boolean
sTable = Mid(ThisDrawing.GetVariable("dwgname"), 1, 3)
bFoundTable = False
For Each spaceTbl In cat.Tables
If UCase(spaceTbl.Name) = UCase(sTable) Then
bFoundTable = True
Exit For
End If
Next
If bFoundTable Then
'''Delete all records in the table that matches sTable whoes field, DrawingName, matches dwgname
'I currently have the next line in here, but that deletes everything, including the table.
cat.Tables.Delete sTable
End If
With spaceTbl
.Name = sTable
.Columns.Append "Handle"
.Columns.Append "RoomNumber"
.Columns.Append "RoomName"
.Columns.Append "Area"
.Columns.Append "Style"
.Columns("RoomNumber").Attributes = adColNullable
.Columns("RoomName").Attributes = adColNullable
.Columns("Area").Attributes = adColNullable
.Columns("Style").Attributes = adColNullable
Dim index As New ADOX.index
index.Name = "Handle"
index.Columns.Append "Handle"
index.Unique = True
index.PrimaryKey = True
spaceTbl.Indexes.Append index
cat.Tables.Append spaceTbl
Set cnn = cat.ActiveConnection
End With
Dim spaceRs As New ADODB.Recordset
spaceRs.Open sTable, cnn, adOpenKeyset, adLockOptimistic
For Each obj In ThisDrawing.ModelSpace
If TypeOf obj Is AecSpace Then
Set space = obj
Set cPropSets = SchedApp.PropertySets(space)
Set PropSet = cPropSets.Item("SpaceObjects")
If Not PropSet Is Nothing Then
Set cProps = PropSet.Properties
spaceRs.Find "Handle = '" & space.Handle & "'"
If spaceRs.EOF Then
spaceRs.AddNew
spaceRs!Handle = space.Handle
End If
spaceRs!Area = cProps.Item("BaseArea").value
spaceRs!Style = cProps.Item("Style").value
spaceRs.Update
End If
Set PropSet = cPropSets.Item("RoomObjects")
If Not PropSet Is Nothing Then
Set cProps = PropSet.Properties
spaceRs.Find "Handle = '" & space.Handle & "'"
If spaceRs.EOF Then
spaceRs.AddNew
spaceRs!Handle = space.Handle
End If
spaceRs!RoomNumber = cProps.Item("Number").value
spaceRs!RoomName = cProps.Item("Name").value
spaceRs.Update
End If
End If
Next
Set cat = Nothing
End Sub