Author Topic: BLockDef Table and Layers  (Read 5283 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
BLockDef Table and Layers
« on: February 12, 2008, 12:02:09 PM »
Hi
I was wondering if anyone has code that will tell me what layers a block is comprised of without exploding the block?

I have a drawing with several block and I need to know what layers were used to create the block "not" what layer the block is on

I believe this info will have to come from the block def table; not sure.

Does anyone have anthing that can get me that info?

Thank you!
Mark

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #1 on: February 12, 2008, 12:45:00 PM »
dim B as acadblock
set b=thisdrawing.blocks("yours")
for each ent in b
debug.print b.layer
next

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #2 on: February 12, 2008, 12:54:06 PM »

Hey Bry

Not working!

Also, I am hoping to print (debug.print) the block name, then all associated layers below it.

Mark

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #3 on: February 12, 2008, 02:36:20 PM »
Yep that was lame

Sub Blocklayers()

    Dim B As AcadBlock
    Dim Ent As AcadEntity
    Dim P
   
    ThisDrawing.Utility.GetEntity Ent, P, "Pick a blockref"
    If Not TypeOf Ent Is AcadBlockReference Then Exit Sub
    If Ent Is Nothing Then Exit Sub
    Set B = ThisDrawing.Blocks(Ent.Name)
    Debug.Print "The block " & B.Name & "uses the following layers:"
    For Each Ent In B
        Debug.Print Ent.Layer
    Next
   
End Sub

You need to make a collection of layers and only add a new one when it is not already there.
then print the collection

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #4 on: February 12, 2008, 02:54:01 PM »

Yes sir!

That is much better!
Thanks Bry!

The only thing I noticed is that I can only select one block at a time; I guess to be able to multi select, I would need to create a filteres Sset as well? Retorical question :)

Also, the other thing is that when I choose a block that is on layer 0, it prints 0 about 10 times; not sure why?

Mark


ML

  • Guest
Re: BLockDef Table and Layers
« Reply #5 on: February 12, 2008, 02:56:06 PM »

Bry
I'm also not sure what you mean here?

Quote
'You need to make a collection of layers and only add a new one when it is not already there.
'then print the collection

Mark

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #6 on: February 12, 2008, 03:45:34 PM »
Mark here is a slightly better version.
I've used a collection rather than an array only because it is easier (arrays are faster if used correctly).
The multi select is the same code with a while wend loop or do while loop
Code: [Select]
Sub Blocklayers()

    Dim B As AcadBlock
    Dim Ent As AcadEntity
    Dim P
    Dim LayerCol As New Collection
    Dim slayer As String
    Dim i As Integer
   
   
    ThisDrawing.Utility.GetEntity Ent, P, "Pick a blockref"
    If Not TypeOf Ent Is AcadBlockReference Then Exit Sub
    If Ent Is Nothing Then Exit Sub
    Set B = ThisDrawing.Blocks(Ent.Name)
    Debug.Print "The block " & B.Name & "uses the following layers:"
    For Each Ent In B
        slayer = Ent.Layer
        For i = 1 To LayerCol.count
            If LayerCol(i) = slayer Then GoTo skip
        Next
        LayerCol.Add slayer
skip:
    Next
    For i = 1 To LayerCol.count
        Debug.Print LayerCol(i)
    Next
End Sub

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #7 on: February 12, 2008, 04:04:29 PM »

Hey Bry
That is very nice! Thank you
It is working very well.

While I understand what collections are as we program with collections of objects every day;
I never created a collection; therefore I am not quite sure of its intent in the code.
While it is working fine; it is my curiousity that needs to know.
So Bry, what is the reason for the collection? :)

Thanks
Mark



Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #8 on: February 12, 2008, 06:51:54 PM »
See the 2D Array Help post for more info on arrays.
But collections are a slow, high overhead and very easy way of storing objects.
Here the collection is needed to store the layer names and as each layer comes up you can check to see if it is already there, if so bail.
Collections don't need to be dimmed as a certain size, you merely add or remove as you go.
You can also add arrays to the collection.
However you don't see the good coders use them as much as arrays, as they are slower.

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #9 on: February 12, 2008, 06:55:07 PM »
If we get lucky Mp will see this and perhaps give a short explanation of a collection.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: BLockDef Table and Layers
« Reply #10 on: February 12, 2008, 07:16:59 PM »
I'm not VBA'er, so take this post as that....


But if you say that arrays are faster, why don't you use an array with the max limit the number of layers in the drawing?  Then you can have a count variable so you know where to put it in the array, and also to know when to stop printing the array values to the command line?

Or am I way off base?
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #11 on: February 12, 2008, 07:20:57 PM »
Yep, that's a goer. I was hoping Ml will take it from here and do just that.
He'll probably want to put the layers in alphabetical order as well.


T.Willey

  • Needs a day job
  • Posts: 5251
Re: BLockDef Table and Layers
« Reply #12 on: February 12, 2008, 07:23:08 PM »
Yep, that's a goer. I was hoping Ml will take it from here and do just that.
He'll probably want to put the layers in alphabetical order as well.


Okay, thanks.  I'm just thinking along the lines of programing, and thought that this might apply to C# (.Net), that is why I asked the question.   :-)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Joro--

  • Guest
Re: BLockDef Table and Layers
« Reply #13 on: February 13, 2008, 06:48:23 AM »
A little modification of Bryco's code with arrays

Code: [Select]
Sub Blocklayers()

    Dim B As AcadBlock
    Dim Ent As AcadEntity
   
    Dim UsedLayers() As String
    Dim N As Double
    Dim P
    Dim i As Double
    Dim Found As Boolean
    Dim MSG As String
   
    ThisDrawing.Utility.GetEntity Ent, P, "Pick a blockref"
    If Not TypeOf Ent Is AcadBlockReference Then Exit Sub
    If Ent Is Nothing Then Exit Sub
    Set B = ThisDrawing.Blocks(Ent.Name)
   
    N = -1
    For Each Ent In B
        If N = -1 Then
            N = N + 1
            ReDim UsedLayers(N)
            UsedLayers(N) = Ent.Layer
            MSG = MSG & vbCr & Ent.Layer
        Else
            Found = False
            For i = 0 To UBound(UsedLayers)
                If UsedLayers(i) = Ent.Layer Then
                    Found = True
                    Exit For
                End If
            Next
            If Found = False Then
                N = N + 1
                ReDim Preserve UsedLayers(N)
                UsedLayers(N) = Ent.Layer
                MSG = MSG & vbCr & Ent.Layer
            End If
        End If
    Next
    MsgBox "Layers used in the block:" & vbCr & MSG
   
End Sub

Bryco

  • Water Moccasin
  • Posts: 1882
Re: BLockDef Table and Layers
« Reply #14 on: February 13, 2008, 10:37:52 AM »
Joro, that's a nice try, but you may want to look at the way you are redimming
If you are interested below code makes a benchmark block, to insert in a drawing then running tch  you can check the times on each method
I get  0.2792969  for your method
0.1601563 using BlocklayerswithCol ent

Code: [Select]
Sub tch()

    Dim P
    Dim ent As AcadEntity
    ThisDrawing.Utility.GetEntity ent, P, "Pick a blockref"
        If Not TypeOf ent Is AcadBlockReference Then Exit Sub
        If ent Is Nothing Then Exit Sub
   
    Dim t As Single
    t = Timer
    Blocklayers ent
    'BlocklayerswithCol ent
    Debug.Print Timer - t
   
End Sub

Sub Blocklayers(ent As AcadEntity)

    Dim b As AcadBlock
    Dim UsedLayers() As String
    Dim N As Double
    Dim P
    Dim i As Double
    Dim Found As Boolean
    Dim msg As String
   
    Set b = ThisDrawing.Blocks(ent.Name)
   
    N = -1
    For Each ent In b
        If N = -1 Then
            N = N + 1
            ReDim UsedLayers(N)
            UsedLayers(N) = ent.Layer
            msg = msg & vbCr & ent.Layer
        Else
            Found = False
            For i = 0 To UBound(UsedLayers)
                If UsedLayers(i) = ent.Layer Then
                    Found = True
                    Exit For
                End If
            Next
            If Found = False Then
                N = N + 1
                ReDim Preserve UsedLayers(N)
                UsedLayers(N) = ent.Layer
                msg = msg & vbCr & ent.Layer
            End If
        End If
    Next
    'MsgBox "Layers used in the block:" & vbCr & msg
   
End Sub


Sub BlocklayerswithCol(ent As AcadEntity)

    Dim b As AcadBlock
    Dim LayerCol As New Collection
    Dim slayer As String
    Dim i As Integer
    Dim msg As String
   
    Set b = ThisDrawing.Blocks(ent.Name)
    For Each ent In b
        slayer = ent.Layer
        For i = 1 To LayerCol.count
            If LayerCol(i) = slayer Then GoTo skip
        Next
        LayerCol.Add slayer
skip:
    Next
    For i = 1 To LayerCol.count
        msg = msg & vbCr & LayerCol(i)
    Next
    'MsgBox "Layers used in the block:" & vbCr & msg
End Sub

Sub addblockandlayers()

    Dim b As AcadBlock
    Dim l As AcadLayer
    Dim ls As AcadLayers
    Dim bs As AcadBlocks
    Set ls = ThisDrawing.LAYERS
    Set bs = ThisDrawing.Blocks
    Set b = bs.Add(Zero, "b")
    Dim c As AcadCircle
    Dim i As Integer
    Dim cen(2) As Double
    For i = 1 To 250
        Set l = ThisDrawing.LAYERS.Add(i)
        l.Color = i
        cen(0) = i
        Set c = b.AddCircle(cen, 5)
        c.Layer = i
        Set c = b.AddCircle(cen, 3)
        c.Layer = i
    Next
End Sub