Getting the layer property of a block

[Anonymous]

Hi,

I'm a newbie so please be gentle with me! I'm trying to get the layer property of a block but i get an error that says -

Object doesnt support this propery or method when it gets to this part of my code

blname = block.Layer

I'm sure there's a much better way to do what i'm trying to do so any help would be appreciated. I'm trying to find all layers that begin with LN and have 6 characters, add the total length of lines for each of those layers, and find any blocks that begin with ELB_90 or ELB_45 on each of those layers and adjust the total accordingly. Then send that information to three listboxes, one for the layers, one for line lengths and one for block totals.

Here's my attempt!

Private Sub Cmd1_Click()

Dim entry As AcadLayer
Dim lname As Variant
Dim fname As Variant
Dim ename As String
Dim tot As Long
Dim EntObj As AcadObject
Dim block As AcadBlock
Dim test As Variant
Dim bname As Variant
Dim btotal As Single

'Find all layers that begin with LN & have 6 characters and add to lisbox
For Each entry In ThisDrawing.Layers
lname = entry.Name
tot = 0
btotal = 0
If Mid(lname, 1, 2) = "LN" And Len(lname) = 6 Then
ListBox1.AddItem entry.Name

'Search through all lines and if correct layer then add to tot
For j = 0 To ThisDrawing.ModelSpace.Count - 1
Set EntObj = ThisDrawing.ModelSpace.Item(j)
fname = EntObj.Layer
ename = EntObj.ObjectName
If fname = lname And ename = "AcDbLine" Then
tot = tot + EntObj.Length
End If

'Search through all blocks that begin with ELB_90 or ELB_45 and add
For Each block In ThisDrawing.Blocks
bname = block.Name
blname = block.Layer
If Mid(bname, 1, 6) = "ELB_90" And blname = lname Then
btotal = btotal + 1
ElseIf Mid(bname, 1, 6) = "ELB_45" And blname = lname Then
btotal = btotal + 0.5
End If
Next
Next j
ListBox2.AddItem tot
ListBox3.AddItem btotal
End If
Next

End Sub

Thanx in advance.

[bcoward]

A little help so you can help yourself might assist you...and us.

When you get the error message and select "Debug" which line is highlighted within the IDE?

Good luck,

Bob Coward
CADS, Inc

800-366-0946
bcoward@mindspring.com

[Anonymous]

pienpeas wrote: > Hi, > > I'm a newbie so please be gentle with me! I'm trying to get the layer > property of a block but i get an error that says - Drop all the iteration. You already know what you're looking for so use a filtered selection set. > Object doesnt support this propery or method when it gets to this > part of my code > > blname = block.Layer Blocks (i.e. block definitions) do not have layers. Inserts (i.e. block references) do.

[Anonymous]

Hi again,

Bob, the line is

blname = block.Layer

Frank, yeah i know what i want to do, but not sure how to go about it. Most of what i have learnt has been from reading through posts on this forum, so my code is mostly bits and pieces of other peoples code that i have copied. It all seems a bit jumbled to me and i'm not sure if i'm going the right way about what i am trying to achieve.

I was thinking that i should be looking at blockreference instead of block.

[bcoward]

I for one am glad to see you took some initiative and checked which line was your problem child. An attaboy for ya'.

As you indicated "I was thinking that i should be looking at blockreference instead of block"

This is exactly what Frank wanted you to get from his post. Guess what? You used to be a newbie, now you see the forest through the trees.

good luck,

Bob Coward
CADS, Inc

800-366-0946
bcoward@mindspring.com

[Anonymous]

🙂

OK, now i know what i should be looking for, i'm unsure of the syntax to use to loop through each block insert, can you give me a clue as to how i would do this?

I guess that For each block in ThisDrawing.Blocks is not the correct way.

Thanx again

[Jackrabbit]

[pre]
Option Explicit

Private Sub CommandButton1_Click()
Dim BlockTotal As Single
Dim Entity As AcadEntity
Dim Layer As AcadLayer
Dim TotalLineLength As Double

' Find all layers that begin with LN & have 6 characters and add to lisbox.
For Each Layer In ThisDrawing.Layers
If (Left$(Layer.Name, 2) = "LN") And (Len(Layer.Name) = 6) Then
ListBox1.AddItem Layer.Name
End If
Next Layer

' Search for lines and block references on the target layers.
For Each Entity In ThisDrawing.ModelSpace
If (Left$(Entity.Layer, 2) = "LN") And (Len(Entity.Layer) = 6) Then
If TypeOf Entity Is AcadLine Then
TotalLineLength = TotalLineLength + Entity.Length
ElseIf TypeOf Entity Is AcadBlockReference Then
Select Case Entity.Name
Case "ELB_90": BlockTotal = BlockTotal + 1#
Case "ELB_45": BlockTotal = BlockTotal + 0.5
End Select
End If
End If
Next Entity

' Update the list boxes.
ListBox2.AddItem TotalLineLength
ListBox3.AddItem BlockTotal
End Sub
[pre]

[Anonymous]

Ahhh....i guess thats how i should be doing it.

Thanx very much.

[bcoward]

I'm not in agreement regarding the use of the Single Data type.

I can only offer http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q279/7/55.asp&NoWebContent=1 to support this statement.

Regards,

Bob Coward
CADS, Inc

800-366-0946
bcoward@mindspring.com

[NathTay]

Have a look at Filtered Selection Sets. I have a couple of functions that I use below. CreateEmptySSet as the name suggests returns an empty selection set and is used by CreateSSet. CreateSSet expects a True or False value to be passed as to whether the user should select objects & accepts a Parrameter Array of filter values. UseFiteredSSet is an example of how to use it in your project.
-------------------------------------------------------
Option Explicit

Public Sub UseFilteredSSet()
Dim objSSet As AcadSelectionSet
Dim objLine As AcadLine
Dim objBlockRef As AcadBlockReference

Set objSSet = CreateSSet(False, 8, lname, 0, "LINE")
For Each objLine In objSSet

Next objLine
objSSet.Delete

Set objSSet = CreateSSet(False, 8, lname, 0, "INSERT", 2, "ELB_90")
For Each objBlockRef In objSSet

Next objBlockRef
objSSet.Delete

End Sub

Public Function CreateSSet(blnUserSelect As Boolean, ParamArray varFilter() As Variant) As AcadSelectionSet
Dim intCount As Integer
Dim intFtype() As Integer
Dim varFdata() As Variant
Dim intIndex As Integer
Set CreateSSet = CreateEmptySSet
If UBound(varFilter) = -1 Then
If blnUserSelect = True Then
CreateSSet.SelectOnScreen
Else
CreateSSet.Select acSelectionSetAll
End If
Else
intIndex = ((UBound(varFilter) + 1) / 2) - 1
ReDim intFtype(intIndex)
ReDim varFdata(intIndex)
intIndex = 0
For intCount = 0 To UBound(varFilter) Step 2
intFtype(intIndex) = CInt(varFilter(intCount))
varFdata(intIndex) = varFilter(intCount + 1)
intIndex = intIndex + 1
Next intCount
If blnUserSelect = True Then
CreateSSet.SelectOnScreen intFtype, varFdata
Else
CreateSSet.Select acSelectionSetAll, , , intFtype, varFdata
End If
End If
End Function

Public Function CreateEmptySSet() As AcadSelectionSet
Dim blnExists As Boolean
Dim intCount As Integer
Dim strName As String
Dim objSSet As AcadSelectionSet
blnExists = True
intCount = 0
Do Until blnExists = False
blnExists = False
intCount = intCount + 1
strName = "SSET" & intCount
For Each objSSet In ThisDrawing.SelectionSets
If UCase(objSSet.Name) = strName Then blnExists = True
Next objSSet
Loop
Set CreateEmptySSet = ThisDrawing.SelectionSets.Add(strName)
End Function
-------------------------------------------------------
Regards - Nathan

[Anonymous]

Thanks Nathan, that's probably a little over my head at the moment but i'll keep that and try and figure it out.

Jackrabbits code doesnt do what i wanted to do, i get one total for all lines on the LN layers and one block count. I want a line length and block count total for each of the LN layers, BUT, it certainly shows me how i can go about doing it.

Bob, regarding using the Single data type. Is it better to use the variant data type instead and then use CDec function?

Thanks.