How to bring object to Front?

November 27, 2009

Hi there,

Because i'm using a wipeout in some blocks i want to place these on top. Sometimes the blocks are placed accidentaly under lines so the line is fully visible.

Because I also have a database connection which selects each block I also want to place it on top in that same routine.

 

Public Elem As Object

   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

[color=red]                Elem.MoveToTop (DOESNT WORK?!)[/color]

               End If
           End If
       End With
   Next Elem

The VBA help didn't help me out much... Can you guys help me?

Thnx!!

November 27, 2009

Hi there,

Because i'm using a wipeout in some blocks i want to place these on top. Sometimes the blocks are placed accidentaly under lines so the line is fully visible.

Because I also have a database connection which selects each block I also want to place it on top in that same routine.
 

Public Elem As Object

   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

[color=red]                Elem.MoveToTop (DOESNT WORK?!)[/color]

               End If
           End If
       End With
   Next Elem
The VBA help didn't help me out much... Can you guys help me?

Thnx!!

here is an example from Help, slightly changed

hope this make a sense

Option Explicit

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim i As Integer
Dim setName As String

setName = "$Order$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen

If oSset.Count > 0 Then
ReDim arrObj(0 To oSset.Count - 1) As AcadObject
'Process each object
i = 0
For Each oEnt In oSset
Set arrObj(i) = oEnt
i = i + 1
Next
End If

On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary

' 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

'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
Application.Update

Exit Sub
Err_Control:
If Err.Number 0 Then MsgBox Err.Description
End Sub

~'J'~

November 27, 2009

Thanks for your response fixo!

It works fine. One simple question is left....

How to fill that oSset? I don't want to select on screen. I made a own range of objects:

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim I As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For I = 0 To ThisDrawing.SelectionSets.Count - 1
   If ThisDrawing.SelectionSets.Item(I).Name = setName Then
       ThisDrawing.SelectionSets.Item(I).Delete
   Exit For
   End If
Next I
Set oSset = ThisDrawing.SelectionSets.Add(setName)

[color=red] ReDim ssobjs(0 To ThisDrawing.Blocks.Count - 1) As AcadBlock[/color]
[color=red] I = 0[/color]
[color=red] For I = 0 To ThisDrawing.Blocks.Count - 1[/color]
[color=red]     Set ssobjs(I) = ThisDrawing.Blocks.Item(I)[/color]
[color=red] Next[/color]

[color=red] ' Add the array of objects to the selection set[/color]
[color=red] [b]oSset.AddItems ssobjs[/b][/color]

If oSset.Count > 0 Then
ReDim arrObj(0 To oSset.Count - 1) As AcadObject
'Process each object
I = 0
For Each oEnt In oSset
Set arrObj(I) = oEnt
I = I + 1
Next
End If
On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
' 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
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description

Where the text is bold it gives error: Method 'AddItems' of object 'IAcadSelectionSet' failed.

I've tried to dim ssobjs as Object, AcadEnitity, Variant and AcadObject and it stil doesnt work.

How come? What's wrong? What's the answer?

November 27, 2009

Thanks for your response fixo!

It works fine. One simple question is left....

How to fill that oSset? I don't want to select on screen. I made a own range of objects:

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim I As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For I = 0 To ThisDrawing.SelectionSets.Count - 1
   If ThisDrawing.SelectionSets.Item(I).Name = setName Then
       ThisDrawing.SelectionSets.Item(I).Delete
   Exit For
   End If
Next I
Set oSset = ThisDrawing.SelectionSets.Add(setName)

[color=red] ReDim ssobjs(0 To ThisDrawing.Blocks.Count - 1) As AcadBlock[/color]
[color=red] I = 0[/color]
[color=red] For I = 0 To ThisDrawing.Blocks.Count - 1[/color]
[color=red]     Set ssobjs(I) = ThisDrawing.Blocks.Item(I)[/color]
[color=red] Next[/color]

[color=red] ' Add the array of objects to the selection set[/color]
[color=red] [b]oSset.AddItems ssobjs[/b][/color]

If oSset.Count > 0 Then
ReDim arrObj(0 To oSset.Count - 1) As AcadObject
'Process each object
I = 0
For Each oEnt In oSset
Set arrObj(I) = oEnt
I = I + 1
Next
End If
On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
' 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
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description

Where the text is bold it gives error: Method 'AddItems' of object 'IAcadSelectionSet' failed.

I've tried to dim ssobjs as Object, AcadEnitity, Variant and AcadObject and it stil doesnt work.

How come? What's wrong? What's the answer?

Sorry, but you confuse concepts of AcadBlock and AcadBlockReference

Please, take a look at the Help file about

Here is the code without of using selection set

Sub OrderToTop()
' This example creates a SortentsTable object and
' changes the draw order of inserted block regerence(s) to top.

Dim oEnt As AcadEntity
Dim oLayout As AcadLayout
Dim I As Integer
Dim ssobjs() As AcadEntity
I = 0
For Each oLayout In ThisDrawing.Layouts
For Each oEnt In oLayout.Block
If TypeOf oEnt Is AcadBlockReference Then
ReDim Preserve ssobjs(I) As AcadEntity
Set ssobjs(I) = oEnt
I = I + 1
End If
Next
Next

On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
' 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
'Move selected object(s) to the top
sentityObj.MoveToTop ssobjs 'arrObj
Application.Update
Exit Sub
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description
End Sub

~'J'~

November 27, 2009

Always a tricky part. AcadBlocks etc....

But to the point: IT WORKS GREAT!

Thank you very plenty!!! :wink:

November 27, 2009

Always a tricky part. AcadBlocks etc....

But to the point: IT WORKS GREAT!

Thank you very plenty!!! :wink:

Glad to help

Cheers

~'J'~

Sign In

How to bring object to Front?

Recommended Posts

Grenco

fixo

Grenco

fixo

Grenco

fixo

Join the conversation

Tutorials

Forums

Activity