• This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Leggi altro.

Cambio tipolinea all'interno dei blocchi

tiziano69

Utente Standard
Professione: disegnatore tecnico
Software: autocad + inventor
Regione: terni
#1
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
 

tiziano69

Utente Standard
Professione: disegnatore tecnico
Software: autocad + inventor
Regione: terni
#2
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
 

tiziano69

Utente Standard
Professione: disegnatore tecnico
Software: autocad + inventor
Regione: terni
#3
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
 

tiziano69

Utente Standard
Professione: disegnatore tecnico
Software: autocad + inventor
Regione: terni
#4
Non funziona, mi analizza anche le entita fuori dai blocchi. Perche ?

Aiuto
 

dieva

Utente Standard
Professione: CAD Manager - AutoCAD sw developer
Software: AutoCAD | BricsCAD | 3DSMax | Revit
Regione: puglia
#5
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) :)

HTML:
Function cambia_tipolinea_blocchi()

'-------------------------------------
Dim BLOCCHI As AcadBlocks
Dim i As Integer
Set BLOCCHI = ThisDrawing.Blocks

Dim nome_tipolinea_prec As String
Dim nuovo_tipolinea As String
Dim tipolinea As String

'INPUT UTENTE
nome_tipolinea_prec = UCase(InputBox("nome tipolinea da sostituire"))
nuovo_tipolinea = UCase(InputBox("Nome del nuovo tipolinea"))

' CICLO CHE ANALIZZA TUTTI I BLOCCHI DEL DISEGNO
For i = 0 To BLOCCHI.Count - 1

    If BLOCCHI(i).Name Like "*MODEL_SPACE" Or BLOCCHI(i).Name Like "*PAPER_SPACE" Then
           
        Else
            ' CICLO CHE ANALIZZA TUTTE LE ENTITA' DEL BLOCCO
            For X = 0 To BLOCCHI(i).Count - 1
               tipolinea = BLOCCHI(i).Item(X).Linetype
                
                If UCase(tipolinea) = nome_tipolinea_prec Then
                    BLOCCHI(i).Item(X).Linetype = nuovo_tipolinea
                End If
            Next X
    End If

Next i

ThisDrawing.Regen acActiveViewport

End Function
 

tiziano69

Utente Standard
Professione: disegnatore tecnico
Software: autocad + inventor
Regione: terni
#6
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