Author Topic: BLockDef Table and Layers  (Read 2714 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: 1850
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: 1850
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: 1850
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: 1850
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: 1850
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: 5218
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: 1850
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: 5218
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: 1850
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

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #15 on: February 13, 2008, 12:19:31 PM »

Hey Guys!

Thanks again! Thanks Bry for the explanation.

I'm just pinging back in to the discussion:

I am definitely more accustom to programming with arrays and that was the method that I started out using before I finally folded and decided to post for a bit of help.

If, you had just coded with an array initially, I likely would have said thanks Bry and moved on.
It was the fact that you used the collection that peaked my interest.

Recently, I saw someone bring in data from a stored procedure from SQL and assign that data to a New Collection and I just thought, that was the coolest thing.
So while I have been at VBA for a few years, there are certainly methods I have not touched yet; like New Collections, Class Modules and so on.

I guess that is one of the beauties of programming, there is always more to learn.

I will definitely examine you code closer and see if I can not apply that method with another example.

Now, after The Collection is created, you could then create properties and methods as well to those objects, couldn't you?

Thanks!

Mark


ML

  • Guest
Re: BLockDef Table and Layers
« Reply #16 on: February 13, 2008, 03:46:28 PM »

Bry

I now have (with some help from CM) a Do Until Loop in the code
However, I am not sure how to handle clearing The Laycol after each loop cycle?
As a result, I am picking my first block, it is printing out the proper layer info but after I pick the next block, it is printing out the layers from the last block picked, plus the new layers.

Any suggestions?

Thanks again!
Mark

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #17 on: February 13, 2008, 05:26:32 PM »

OK, here is the code that Bry posted only it will now loop through and keep prompting the user for the next block until the user escapes; removing and recreating The LayCol with each loop.
Also, I want to thank CM for his help to advance the code to this point.

Code: [Select]
Sub BlocklayersLoop() 'This Sub will keep prompting for the next block until user escapes.
      Dim B As AcadBlock
      Dim Ent As AcadEntity
      Dim P
      Dim LayerCol As New Collection
      Dim slayer As String
      Dim Picked As Boolean
      Dim i As Integer
     
      Do
       On Error Resume Next
       ThisDrawing.Utility.GetEntity Ent, P, "Pick a blockref"
       If Not TypeOf Ent Is AcadBlockReference Then
        Picked = False
        GoTo ExitOut
       Else
        Picked = True
       End If
       If Ent Is Nothing Then
        Picked = False
        GoTo ExitOut
       Else
        Picked = True
       End If
       
       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
ExitOut:
        Dim Num As Integer
         For Num = 1 To LayerCol.Count
          LayerCol.Remove 1   
         Next
        Loop Until Picked = False
        Exit Sub
End Sub

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: BLockDef Table and Layers
« Reply #18 on: February 14, 2008, 11:01:54 AM »
Your welcome, glad I could help
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ML

  • Guest
Re: BLockDef Table and Layers
« Reply #19 on: February 14, 2008, 11:04:09 AM »

Yes sir!

That's what it is all about

Helping each other!

Forums Kick A*s! :)

Mark