Jump to content

Recommended Posts

Posted

Hi there!

 

Because i'm still working on my database connection and a user interface i've got another question.

 

My problem is that my routine has to work also with older drawings with old blocks. Old blocks don't have a attribute named "GEA-ID". So I want this to check/add when there is a drawing opened or an object is added.

 

When a drawing is opened:

Sub ACADApp_EndOpen(ByVal FileName As String)
   If ThisDrawing.GetVariable("WRITESTAT") = 0 Then
       Exit Sub
   End If
   If Not (Left(ThisDrawing.Name, 1)) = "~" Then
       Exit Sub
   End If
   Call Check_If_CORRECT_GEA_ID_Is_In_Block
End Sub

Sub Check_If_GEA_ID_Is_In_Block() 'Elem, Handle, NewOrNot As Boolean)
Dim attributeObj As AcadAttribute
Dim BlockObj As AcadBlock
Dim InsertionPnt(0 To 2) As Double

For Each Elem In ThisDrawing.ModelSpace
   With Elem
       If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
           If ((Elem.HasAttributes) And (Left(Elem.EffectiveName, 3) = "G_B") Or (Left(Elem.EffectiveName, 3) = "G_E") Or _
               (Left(Elem.EffectiveName, 3) = "G_I") Or (Left(Elem.EffectiveName, 3) = "G_L")) Then
               Attributen = Elem.GetAttributes
               Found = False

               ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & Elem.EffectiveName & vbCr 'NODIG???????

               For Count = LBound(Attributen) To UBound(Attributen) 'Read attributes from block
                   If Attributen(Count).TagString = "GEA_ID" Then
                       Found = True
                   End If
               Next Count

               If Found = False Then
                   Set BlockObj = ThisDrawing.Blocks(Elem.EffectiveName)
                   InsertionPnt(0) = 0#: InsertionPnt(1) = 0#: InsertionPnt(2) = 0#
                   Set attributeObj = BlockObj.AddAttribute(1, acAttributeModeInvisible, "GEA_ID", InsertionPnt, "GEA_ID", "")
                   attributeObj.Layer = "Attrib-Hidden"
                   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & Elem.EffectiveName & vbCr
                   ThisDrawing.Regen (acActiveViewport) 'NODIG??
               End If
           End If
       End If
   End With
Next Elem
End Sub

 

This works OK. But not perfect. The sendcommand _ATTSYNC isn't fast enough. Isn't there a way to do it in the background (VBA)? Most of the drawings have more then 1000 objects so it has to send that command 1000 times. I have to do a ATTSYNC because otherwise I cant find that added attribute. Another thing with ATTSYNC is that it resets the attribute, so when an old block is mirrored and the attribute grippoint it's moved from it's original position by the user. The text is set to it's original point and it could be backwards when it was mirrored. The whole drawing is a mess then. Is there a way to fix this?

 

For Adding (like copying):

[color=red][b]Public Sub AcadDocument_ObjectAdded(ByVal Elem As Object)[/b][/color]
Dim Handle As String
Dim Attributen As Variant
Dim Found As Boolean
Dim InsertionPnt(0 To 2) As Double

   On Error GoTo ErrHandler
   'Renew Handle in GEA_ID Attribute
   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & Elem.EffectiveName & vbCr

   With Elem
       If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
           If ((Elem.HasAttributes) And (Left(Elem.EffectiveName, 3) = "G_B") Or (Left(Elem.EffectiveName, 3) = "G_E") Or _
               (Left(Elem.EffectiveName, 3) = "G_I") Or (Left(Elem.EffectiveName, 3) = "G_L")) Then

               Attributen = Elem.GetAttributes
               Found = False
               For Count = LBound(Attributen) To UBound(Attributen) 'Read attributes from block
                   If Attributen(Count).TagString = "GEA_ID" Then
                       Found = True
                       Attributen(Count).TextString = Elem.Handle
                   End If
               Next Count
               If Found = False Then
                   Set BlockObj = ThisDrawing.Blocks(Elem.EffectiveName)
                   InsertionPnt(0) = 0#: InsertionPnt(1) = 0#: InsertionPnt(2) = 0#
                   Set attributeObj = BlockObj.AddAttribute(1, acAttributeModeInvisible, "GEA_ID", InsertionPnt, "GEA_ID", "")
                   attributeObj.Layer = "Attrib-Hidden"
                   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & Elem.EffectiveName & vbCr
                   ThisDrawing.Regen (acActiveViewport) 'NODIG??
               End If
           End If
       End If
   End With
Exit Sub
ErrHandler:
   If Err.Number = 438 Then
       Exit Sub
   Else
       MsgBox Err.Number & Err.Description
   End If
End Sub

With this one the ATTSYNC is fast enough. Not pretty, but it works. The only thing is that when I use the AcadDocument_ObjectAdded event, it runs 2 times per element so my attribute is added 2 times. Apparently ATTSYNC doesnt make the added attribute visible for VBA so the attribute added again! What am I doing wrong?

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...