Cambio tipolinea all'interno dei blocchi

Buongiorno, ho il seguente problema...
Voglio cambiare il tipolinea "pippo" (presente all'interno dei blocchi) con il tipolinea "alfa".
Questo perche... perche molte volte arrivano disegni DWG che sono stati esportati da MICRO e mi ritrovo numerosi tipolinea che vorrei sostituire ed è impensabile di entrare all'interno di ogni singolo blocco cercare e cambiare ammesso che quel determinato tipolinea ci sia.
Aggiungo, non voglio rinominare il tipolinea va voglio che venga cambiato cosi alla fine della elaborazione non è + utilizzato e lo posso "ELIMINARE" definitivamente.

Ho provato a modificare questo pezzo di codice che serviva a cambiare fattore di scala agli oggetti ma non riesco proprio a capire come poter entrare nei blocchi ed analizzare tutte le sottoentita presenti all'interno del blocco cosi da poter cambiare proprieta


Function cambia_tipolinea()

Dim asa As Object

Set oAutoCad = GetObject(, "AutoCAD.Application")

Set oModelSpace = oAutoCad.ActiveDocument.ModelSpace

Set asa = oAutoCad.ActiveDocument.Blocks

numero_entita = asa.Count
For I = 1 To numero_entita
if asa.item(I)

End Function

Allora, ho scritto questa parte di codice però ho un problema di "indici" nello scansionare le entita presenti all'interno del blocco..... risolto questo, si può poi cambiare tipolinea da codice VBA

Function scrivi_testi()

Dim asa As Object
Dim tipolinea As String

Set oAutoCad = GetObject(, "AutoCAD.Application")

Set oModelSpace = oAutoCad.ActiveDocument.ModelSpace
Set asa = oAutoCad.ActiveDocument.Blocks
Dim nr_ent As Integer


For intI = 1 To asa.Count

If asa.Item(intI).Name <> "Model_Space" Or asa.Item(intI).Name <> "Paper_Space" Then
MsgBox ("è un blocco")

For x = 1 To asa.Item(intI).Count
tipolinea = asa.Item(intI).Item(x).Linetype
MsgBox (tipolinea)
Next x

End If

Next intI
End Function

Allora eccolo qua, credo funzioni, ora è da migliorare sostituende le due "Inputbox" con il pannello "Tlinea" di autocad per selezionare i nomi dei tipolinea.

Function cambia_tipolinea_blocchi()
Dim asa As Object
Dim tipolinea As String

Set oAutoCad = GetObject(, "AutoCAD.Application")
Set oModelSpace = oAutoCad.ActiveDocument.ModelSpace
Set asa = oAutoCad.ActiveDocument.Blocks

Dim nr_ent As Integer

nome_tipolinea_prec = InputBox("nome tipolinea da sostituire")
nuovo_tipolinea = InputBox("Nome del nuovo tipolinea")

For intI = 0 To asa.Count - 1

If asa.Item(intI).Name <> "Model_Space" Or asa.Item(intI).Name <> "Paper_Space" Then
'MsgBox ("è un blocco")

For x = 0 To asa.Item(intI).Count - 1
tipolinea = asa.Item(intI).Item(x).Linetype

If asa.Item(intI).Item(x).Linetype = nome_tipolinea_prec Then
asa.Item(intI).Item(x).Linetype = nuovo_tipolinea
asa.Item(intI).Item(x).Highlight (True)
End If

'MsgBox (tipolinea)
Next x

End If

Next intI

'ThisDrawing.Application.Update
ThisDrawing.Regen acActiveViewport


End Function

Non funziona, mi analizza anche le entita fuori dai blocchi. Perche ?

Aiuto

l'ho riscritta. Con le festività la concentrazione per dirti dove sbagli non la ho ;-) .

Questo codice è più lineare e semplice rispetto al tuo (credo)

Allora ho ridotto il codice a questo, semplificando di molto e interagisce soltanto sui blocchi
funziona anche con la proprieta DaLayer (attenzione ai caratteri)

Private Sub CommandButton2_Click()
Dim Blk As AcadBlock
Dim xrEnt As AcadEntity
Dim b As String

a = InputBox("old")
b = InputBox("new")

For Each Blk In ThisDrawing.Blocks
If Not Blk.IsLayout Then

For x = 0 To Blk.Count - 1

If Blk.item(x).Linetype = a Then
Blk.item(x).Linetype = b
End If
Next x

End If
Next Blk

ThisDrawing.Regen acActiveViewport
End Sub