Solved: AUTOCAD - can't find blocks in polylines

[ALe]

Hi everybody,

for the first time I'm using VBA with autocad on dwg files.

I found on internet a piece of code that is exactly what I was looking for. This sub get all the polylines in the file and extract attributes values from the blocks that stay within each polyline.

The fact is that the code works only with polylines with a few vertexes, doesn't work with complex lines because it doesn't get the blocks ("Etichetta Locale") staying inside the poly area.

Any ideas how to fix it? Thanx in advance.

[vba]
Sub AnalizzaBlocchiInPolilinea(MyPoly As AcadLWPolyline, NomeP As String, IDP As String, AreaP As Double, PerimP As Double)

Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant
'Dim Sset As AcadSelectionSet
Dim element As AcadEntity
Dim Coord As Variant
Dim Sset1 As AcadSelectionSet
Dim element1 As AcadBlockReference
Dim Punti3D As Variant
Dim Pigreco As Double
Pigreco = 4 * Atn(1)
On Error Resume Next
If Not IsNull(AcApp.ActiveDocument.SelectionSets.Item("element")) Then
Set Sset = AcApp.ActiveDocument.SelectionSets.Item("element")
Sset.Delete
End If
Coord = MyPoly.Coordinates
x = ((UBound(Coord) - 1) / 2) + UBound(Coord)
ReDim Punti3D(0 To x + 1) As Double
For I = 0 To UBound(Coord) Step 2
Punti3D(u) = Coord(I)
Punti3D(u + 1) = Coord(I + 1)
u = u + 2
Punti3D(u) = 0
u = u + 1
Next I
If Not IsNull(AcApp.ActiveDocument.SelectionSets.Item("element1")) Then
Set Sset1 = AcApp.ActiveDocument.SelectionSets.Item("element1")
Sset1.Delete
End If
Set Sset1 = AcApp.ActiveDocument.SelectionSets.Add("element1")
Filtertype(0) = 0
Filterdata(0) = "insert"
Sset1.SelectByPolygon acSelectionSetCrossingPolygon, Punti3D, Filtertype, Filterdata
'MsgBox ("selected elements:" & Sset1.Count)

z = 1

'AcApp.ActiveDocument.Regen acAllViewports
For Each element1 In Sset1
If element1.Name = "Etichetta Locale" Then
'element1.Highlight True
'MsgBox ("Object" & z & ":" & element1.Name & vbLf & "Punto inserimento" & vbLf & "x: " & element1.InsertionPoint(0) & vbLf & "y: " & element1.InsertionPoint(1) & vbLf & "Rotazione: " & (element1.Rotation) / Pigreco * 180)
varattributes = element1.GetAttributes
End if
Next

End sub
[/vba]