VBA.Mania

Witam serdecznie forumowiczów

w dziale makra AutoCada znalazłem takie przydatne mi makro do cada: lenght, mierzące długość wszyskich linii, polilinii i łuków znajdujących się na rysunku
Mam pytanko czy nie dało by sie zrobić tego tak by wyrzucał długości linii (np. do pliku txt o nazwie rysunku jak jest to w przypadku makra licz bloki) i do tego podzielił długości linii wg rodzaju linii, na przykład
Continius: X metrów
Dot Xmetrów
Hidden Xmetrów
itd.

Postaram sie poczytać o kolekcjach w vb, ale narazie dla mnie jest tam za dużo niewiadomych ;) , więc za wszelkie wskazówki z góry wielkie dzięki.

'****************************************
'** autor: A. Szarek, (c)2001 **
'** vbamania@ cad.pl **
'** odwiedź www.vbamania.cad.pl **
'****************************************
'...
'...
Private Function Sciezka() As String
'dodana funkcja
Sciezka = ThisDrawing.Path & "\raport.txt"

End Function

Sub Mierz()

Dim dblLength As Double
Dim colEntities As New Collection
Dim oEntity As AcadEntity
Dim strMsg As String

'dodane :
Dim dblDlugoscRodzaju As Double
Dim rodzajLinii As AcadLineType
Dim strSciezka As String
Dim fso, plik As Object

strSciezka = Sciezka()

Set fso = CreateObject("Scripting.FileSystemObject")
Set plik = fso.CreateTextFile(strSciezka, True)
'Koniec dodanych

Set colEntities = New Collection

Zwroc colEntities

dblLength = 0

For Each rodzajLinii In ThisDrawing.Linetypes 'dodane

plik.writeline (rodzajLinii.Name) 'dodane
dblDlugoscRodzaju = 0 'dodane

For Each oEntity In colEntities

  If oEntity.Linetype = rodzajLinii.Name Then  'dodane

  Select Case oEntity.EntityType
   'łuki
    Case 4
       dblLength = dblLength + oEntity.ArcLength
       dblDlugoscRodzaju = dblDlugoscRodzaju + oEntity.ArcLength 'dodane
   'linie
    Case 19
       dblLength = dblLength + oEntity.Length
       dblDlugoscRodzaju = dblDlugoscRodzaju + oEntity.Length 'dodane

    '3D - polilinie, polilinie, LW-Polilinie
    Case 2, 23, 24
      dblLength = dblLength + PlineLength(oEntity)
      dblDlugoscRodzaju = dblDlugoscRodzaju + PlineLength(oEntity) 'dodane
   End Select

   End If 'dodane

Next oEntity

plik.write ("długość : " & dblDlugoscRodzaju & vbCr) 'dodane

Next rodzajLinii 'dodane

plik.writeline ("DŁUGOŚĆ CAŁKOWITA WSZYSTKICH OBIEKTÓW : " & dblLength) 'dodane

'dodane:
plik.Close

Set fso = Nothing

'koniec dodanych

If dblLength = 0 Then strMsg = "Brak elementów posiadających długość." Else _
      strMsg = "Długość elementów wynosi " & dblLength & "."

MsgBox strMsg, vbInformation, "Pomiar długości"

End Sub