Risultati da 1 a 6 di 6
  1. #1
    Utente Standard L'avatar di tiziano69
    Iscritto dal
    2009
    Messaggi
    101
    Professione
    disegnatore tecnico
    Regione
    terni
    Software
    autocad + inventor

    Predefinito 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

  2. #2
    Utente Standard L'avatar di tiziano69
    Iscritto dal
    2009
    Messaggi
    101
    Professione
    disegnatore tecnico
    Regione
    terni
    Software
    autocad + inventor

    Predefinito

    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

  3. #3
    Utente Standard L'avatar di tiziano69
    Iscritto dal
    2009
    Messaggi
    101
    Professione
    disegnatore tecnico
    Regione
    terni
    Software
    autocad + inventor

    Predefinito

    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

  4. #4
    Utente Standard L'avatar di tiziano69
    Iscritto dal
    2009
    Messaggi
    101
    Professione
    disegnatore tecnico
    Regione
    terni
    Software
    autocad + inventor

    Predefinito

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

    Aiuto

  5. #5
    Utente Standard L'avatar di dieva
    Iscritto dal
    2014
    Messaggi
    245
    Professione
    CAD Manager - AutoCAD sw developer
    Regione
    puglia
    Software
    AutoCAD | BricsCAD | 3DSMax | Revit

    Predefinito

    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) :-)

    Codice 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
    ;;;
    ;;; Domenico IEVA
    ;;; www.domenicoieva.com

  6. #6
    Utente Standard L'avatar di tiziano69
    Iscritto dal
    2009
    Messaggi
    101
    Professione
    disegnatore tecnico
    Regione
    terni
    Software
    autocad + inventor

    Predefinito

    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


  • Discussioni Simili

    1. Cambiare tipolinea di più blocchi nidificati
      Di jim78b nel forum Lisp per Autocad
      Risposte: 2
      Ultimo Messaggio: 24-12-2017, 16: 53
    2. Risposte: 3
      Ultimo Messaggio: 23-12-2017, 14: 30
    3. Risposte: 7
      Ultimo Messaggio: 27-03-2010, 16: 58
    4. Rilevare blocchi all'interno di un'area limitata
      Di piratabobo nel forum VBA per Autocad
      Risposte: 6
      Ultimo Messaggio: 29-07-2009, 11: 02
    5. Risposte: 0
      Ultimo Messaggio: 15-01-2008, 16: 52

    Segnalibri

    Segnalibri

    Permessi di Scrittura

    • Tu non puoi inviare nuove discussioni
    • Tu non puoi inviare risposte
    • Tu non puoi inviare allegati
    • Tu non puoi modificare i tuoi messaggi
    •  





    CAD3D.it - la community dei progettisti