TheSwamp
Code Red => VB(A) => Topic started by: ML 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
-
dim B as acadblock
set b=thisdrawing.blocks("yours")
for each ent in b
debug.print b.layer
next
-
Hey Bry
Not working!
Also, I am hoping to print (debug.print) the block name, then all associated layers below it.
Mark
-
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
-
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
-
Bry
I'm also not sure what you mean here?
'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
-
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
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
-
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
-
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.
-
If we get lucky Mp will see this and perhaps give a short explanation of a collection.
-
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?
-
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.
-
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. :-)
-
A little modification of Bryco's code with arrays
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
-
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
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
-
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
-
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
-
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.
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
-
Your welcome, glad I could help
-
Yes sir!
That's what it is all about
Helping each other!
Forums Kick A*s! :)
Mark