Tough VBA Database question

[Grenco]

Good day all,

 

In our company we draw P&ID's with autocad. We use MS Acces (.mdb) files as database for all the components in each drawing so we can make all kinds of itemlists. Most information is in the block its attributes.

 

For now.. Everything is working ok. When we add something to the drawing the following VBA comes in;

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)
   Dim G_tmp_db, G_name_add, G_blname, G_combbl As String
   On Error GoTo Err_objera
   Call G_frmt_chk
   G_tmp_db = Left(G_dwg_path, (Len(G_dwg_path) - 4)) & "_tmpblk"
   G_name_add = Mid(TypeName(Object), 2)

   Set dbblock = opendatabase(G_tmp_db)
   Set rsblock = dbblock.OpenRecordset("Blocks", dbOpenTable)

   If (G_name_add = "AcadBlockReference") Then
       If ((Left(Object.Name, 3) = "G_B") Or (Left(Object.Name, 3) = "G_E") Or _
           (Left(Object.Name, 3) = "G_I") Or (Left(Object.Name, 3) = "G_A")) Then
           rsblock.AddNew
           rsblock("ObjectID") = Object.ObjectID
           rsblock("Handle") = Object.Handle
           rsblock.Update

           rsblock.Close
           dbblock.Close
           Set rsblock = Nothing
           Set dbblock = Nothing

           Dim G_dbf_path As String
           G_dwg_path = thisdrawing.Path & "\" & thisdrawing.Name
           G_dbf_path = Left(G_dwg_path, (Len(G_dwg_path) - 4)) & "-PID.mdb"
           'Verbinding maken met database
           Set dbInfo = opendatabase(G_dbf_path)
           Set rsInfo = dbInfo.OpenRecordset("Attributes", dbOpenTable)
           Set rsData = dbInfo.OpenRecordset("Add_info", dbOpenTable)
           Set rsPED = dbInfo.OpenRecordset("PED_info", dbOpenTable)
           Set rsLink = dbInfo.OpenRecordset("Link_info", dbOpenTable)
           Set rsCdesc = dbInfo.OpenRecordset("Client_desc_info", dbOpenTable)

           ''For Each elem In ThisDrawing.ModelSpace
           With Object
               If ((.HasAttributes) And (Left(elem.Name, 3) = "G_B") Or (Left(elem.Name, 3) = "G_E") Or (Left(elem.Name, 3) = "G_I")) Then
                   'Gea_ordernummer = thisdrawing.GetVariable("PROJECTNAME")
                   Call GEA_code_start.G_update_db(Object, Gea_ordernummer)
                   'MsgBox "Instructie" & thisdrawing.GetVariable("CMDNAMES")
               Else
               End If
           End With

           rsData.Close
           rsPED.Close
           rsLink.Close
           rsCdesc.Close
           rsInfo.Close
           dbInfo.Close
           Set rsData = Nothing
           Set rsPED = Nothing
           Set rsLink = Nothing
           Set rsCdesc = Nothing
           Set rsInfo = Nothing
           Set dbInfo = Nothing
       End If
   End If
   thisdrawing.EndUndoMark

   Exit Sub

Err_objera:
   If Err.Number = 3024 Then Exit Sub Else Resume Next


End Sub

Public Sub G_frmt_chk() 
 Dim l As Integer
   G_name_chk = False
   G_dwg_path = thisdrawing.Path & "\" & thisdrawing.Name

   G_dwg_name = UCase(thisdrawing.Name)
   l = Len(G_dwg_name)
   G_dwg_name = Left(G_dwg_name, l - 4)
   G_name_chk = (Left(G_dwg_name, 1) Like "~")
   writelock = thisdrawing.GetVariable("WRITESTAT") 
   If writelock = 0 Then   
       G_name_chk = False  
   End If                  

End Sub

 

But we want to make our symbols (blocks with attributes) dynamic (visability states). When we add a dynamic block, the insertion time gets too long! Every element in the dynamic block is an "object added" so every element has to go through VBA above. When the dynamic blocks' visability state is changed. It also runs through the VBA. This makes you wait for approx 15 to 45 seconds.

 

Does anyone now how to get it faster? Maybe can I filter dynamic blocks and other elements so only the attributes get through? Any other ideas?

 

Thanks a lot for any tips!

[hugha]

You could cut down database opening overhead by rearranging so dbblock and rsblock are created just before (and only if) they are required:

 

...

 

If (G_name_add = "AcadBlockReference") Then

If ((Left(Object.Name, 3) = "G_B") Or (Left(Object.Name, 3) = "G_E") Or _

(Left(Object.Name, 3) = "G_I") Or (Left(Object.Name, 3) = "G_A")) Then

Set dbblock = opendatabase(G_tmp_db)

Set rsblock = dbblock.OpenRecordset("Blocks", dbOpenTable)

rsblock.AddNew

rsblock("ObjectID") = Object.ObjectID

rsblock("Handle") = Object.Handle

rsblock.Update

 

rsblock.Close

dbblock.Close

Set rsblock = Nothing

Set dbblock = Nothing

 

...

 

 

 

Hope this helps,

 

Hugh Adasmon

Cadro Pty Ltd

www.hatchkit.com.au

 

 

 

[Grenco]

Sorry for the late response...

 

Thanks for your reply. I still havent tested it but it looks more logical.