Autocad 2007 VBA-Draw order in a Block

alright, are you also an augi member? I posted same question over there to see what they could come up with, I could attach a file there.

what I meant by  "wipeouts are set behind everything in my blocks" is this. Sometimes when I insert a block into a dwg that has a wipeout in it, the wipeout is brought to the front in the block reference. To fix this I have to either refedit the block and put the wipeout to the back, I used to do this with the ai_draworder command, not sure if it was available back in 2000i. or open it with the new blockeditor now and set it to the back with the new draworder command (not sure if there's any difference actually but they added it to the rightclick popup)
I have attempted everyway possible to fix this with out code but have gotten no where. it doesnt happen as much in 2007 but it still does occasionally.
The zorder may be a way but I dont know.

<but for now don't you have to add items to the sentityObj object before doing anything with them?>
thats what I thought this bit does:
'********
Dim ObjIds(0) As Long
     ObjIds(0) = BlockEntity.ObjectID
     'ObjIds(1) = leaderObj.ObjectID
     Dim varObject As ACADObject
     Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(0))
     Dim arr(0) As ACADObject
     Set arr(0) = varObject

    'MsgBox arr(0).ObjectName

    'Move the object to the bottom
    sentityObj.MoveToBottom arr '**** I get an invalid input error here.
     AcadApplication.Update
'***********
It works when I use this in another piece of code that inserts a block, creates a leader attaches the block to the leader then sets the leader behind the block. I'll put that code in the dwg I post too. But it doesnt work while I'm "inside" the block reference.
I'm probably going about this all wrong but it was worth a shot. Let me know if you can get on augi forums and I'll post a link, its free too, if you need another forum to subscribe too ;)

WOW big change for 2005

I found auig and the thread

hehe busy

I'm on aiug now, <But it doesnt work while I'm "inside" the block reference> I don't think it's going to. You are in a block reference not the block. I am thinking you would need to grab the block work it and then update the reference. The reason I am thinking this is because you can have 1 block and 60 references to that block. The only differences being the attributes, and what layer the block was inserted on.

I will look into this this weekend and see what I can come up with, I am thinking right now that we would need to reorganize/reorder the block.

Just updating
dragontooth

ah that makes sense, I'll tinker with that too
thanks

I think I got it, and I think you were totally correct dt. I had to create the dictionary "inside" the block not the reference, check it:

'**********
Sub wipeoutsInBlock()
   
    ' Create the block, this is done even if the block is already in the dwg
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "XING_DET_B")
   
   
   
'Gxet an extension dictionary and, if necessary, add a SortentsTable object**this is done "inside" the block.
    Dim eDictionary As Object
    Set eDictionary = blockObj.GetExtensionDictionary '***this was the key
    ' Prevent failed GetObject calls from throwing an exception
    On Error Resume Next
    Dim sentityObj As Object
    Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
   
    On Error GoTo 0
    If sentityObj Is Nothing Then
         ' No SortentsTable object, so add one
         Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
    End If
   
    Dim ents As AcadEntity
    For Each ents In blockObj
    If ents.ObjectName = "AcDbWipeout" Then

     Dim ObjIds(0) As Long
    ObjIds(0) = ents.ObjectID
   
     Dim varObject As ACADObject
    Set varObject = ThisDrawing.ObjectIdToObject(ObjIds(0))
    Dim arr(0) As ACADObject
    Set arr(0) = varObject
   
    'Move the wipeout object to the bottom
    sentityObj.MoveToBottom arr
         
    'MsgBox ents.ObjectName
    End If
    Next
    ThisDrawing.Regen acAllViewports
     
End Sub
 ' *********

what do you think? it seems to work.

Well that looks like it makes sense. The only thing that bugs me is what if the block exists would you still want to use .add? or wouldn't you want to set it = to the existing one? as in ThisDrawing.Blocks( "XING_DET_B") it accomplishes the same thing just clearer. But I haven't tested or tried at this point. Oh don't forget to clear the err object, just in case it throws an error. Otherwise it will show up someplace else and drive you crazy trying to find it. LOL

I'll look at it in 2005 at home with some drawing so I will know what I'm talking about, I tried here and it flipped out 2000i hehe funny till I had to clean up the mess I made.

Later
dragontooth

you're right I changed it to ThisDrawing.Blocks( "XING_DET_B")   and it works too, and clearer, the other was a hold over from the help file example code, doh!
added the err.clear too,

hope you didnt screw up 2000i too bad ;)

this bug has been buggin me since they created wipeouts, r14 I think, feels good to be close to squashin it!

thanks for your help.
have a good weekend.

thanks again dt, this is what I went for now, using it to call from another module:

'********
Public Sub WToF_InBlock(bname As String)
    Dim blockObj As AcadBlock
    Dim eDictionary As AcadDictionary
    Dim sentityObj As Object
    Dim ents As AcadEntity
    Dim arr(0) As ACADObject
    'For Each blockObj In ThisDrawing.Blocks
    Set blockObj = ThisDrawing.Blocks(bname)
        'Gxet an extension dictionary and, if necessary, add a SortentsTable object**this is done "inside" the block.
        Set eDictionary = blockObj.GetExtensionDictionary '***this was the key
        ' Prevent failed GetObject calls from throwing an exception
        On Error Resume Next
        Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
        If Err.Number <> 0 Then
            If sentityObj Is Nothing Then
                ' No SortentsTable object, so add one
                Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
            End If
            Err.Clear   '   just a way to get error numbers if/when they occur
        End If
        On Error GoTo 0
        For Each ents In blockObj
            If ents.ObjectName = "AcDbWipeout" Then
                Set arr(0) = ThisDrawing.ObjectIdToObject(ents.ObjectID)
                'Move the wipeout object to the bottom
                sentityObj.MoveToBottom arr
                'MsgBox ents.ObjectName
            End If
        Next
'    Next
    ThisDrawing.Regen acActiveViewport
    'clean up anything that may be left over
    Set sentityObj = Nothing
    Set eDictionary = Nothing
    Set blockObj = Nothing
    Set ents = Nothing
End Sub
'***********

I'll probably is this in a few different ways, I like the idea of the begin_save event.
thanks

I have not had any luck getting this to work.  I get an error on this line

sentityObj.MoveToBottom arr

But I am using Civil3D 2008 not 2007 if this could be the issue?  I get an invalid input kicked back pretty quickly.

Also, this code moves all the wipeouts to the back but only wipeouts not contained within a block.

You will need to iterate through the entities in the blocks to get to the wipeout.

I took your code exactly except i put it into a CMD button..

But does this not iterate thru?

        For Each ents In blockObj
            If ents.ObjectName = "AcDbWipeout" Then
                Set arr(0) = ThisDrawing.ObjectIdToObject(ents.ObjectID)
                'Move the wipeout object to the bottom
                sentityObj.MoveToBottom arr
                'MsgBox ents.ObjectName
            End If
        Next

IF there is some way I can do this and award points (am still learning experts exchange)