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

Ricerca di blocchi in un disegno

thetmd

Utente Junior
Professione: tecnico
Software: autocad 2008, solidworks, cyclone
Regione: sardegna
#1
Ciao a tutti, mi serve un consiglio: voglio creare una macro che sostituisca tutte le istanze di un blocco dentro un disegno. Non capisco però se, in VBA, ho modo di ricercare direttamente i BlockReference dentro un disegno con qualcosa tipo

Dim Blocco as AcadBlockReference
For each Blocco in <boh?!? entro cosa lo devo cercare??>
.....

Oppure se l'unico modo di ricerca è quello di definire una variabile di tipo block e poi cercare dentro tutti i blocchi del disegno se trovo quello con il nome che mi interessa

Dim Blocco as AcadBlock
for each Blocco in thisdrawing.blocks
if blocco.name ecc.. ecc..
(ok, non ricordo se la proprietà è proprio name o altro :p ma al momento è ininfluente)

Potete darmi qualche suggerimento? :confused:
Grazie
Pierpaolo
 

Shape

Utente Senior
Professione: Disegnatore Carpenteria
Software: Autocad, VBA-AutoLisp, Tecnometal4D, GIMP
Regione: Friuli
#3
Ciao a tutti, mi serve un consiglio: voglio creare una macro che sostituisca tutte le istanze di un blocco dentro un disegno. Non capisco però se, in VBA, ho modo di ricercare direttamente i BlockReference dentro un disegno con qualcosa tipo
Grazie
Pierpaolo



Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant

On Error Resume Next
' Delete the Selection Set if it Exists
If Not IsNull(ThisDrawing.SelectionSets.Item("element")) Then
Set sset = ThisDrawing.SelectionSets.Item("element")
sset.Delete
End If

ltscale = ThisDrawing.GetVariable("ltscale")

Set sset = ThisDrawing.SelectionSets.Add("element")


Filtertype(0) = 0
Filterdata(0) = "insert"

sset.SelectOnScreen Filtertype, Filterdata


se oltre alle entità blocco vuoi anche filtrare la selezione con un nome blocco

Dim Filtertype(1) As Integer
Dim Filterdata(1) As Variant

Filtertype(0) = 0
Filterdata(0) = "insert"
Filtertype(1) = 2
Filterdata(1) = "nome blocco"


questo metodo utilizza i codici dxf delel entita

es per vedere i codici

Comando: (entget(car(entsel)))

Selezionare oggetto: ((-1 . <Nome entità: 7de10290>) (0 . "INSERT") (330 .
<Nome entità: 7e0e8cd0>) (5 . "5FA") (100 . "AcDbEntity") (67 . 0) (410 .
"Model") (8 . "G") (100 . "AcDbBlockReference") (2 . "NOME") (10 152.768
6.8475e-013 1.56769e-013) (41 . -1.0) (42 . 1.0) (43 . 1.0) (50 . 3.14159) (70
. 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 -2.13399e-016 -0.63034 -0.776319))
 
Ultima modifica:

thetmd

Utente Junior
Professione: tecnico
Software: autocad 2008, solidworks, cyclone
Regione: sardegna
#4
Ciao. Scusa SHAPE temo di essere stato troppo prolisso nella mia domanda. Cerco di spiegarmi meglio.
Ho una serie di disegni con alcuni simboli ripetuti diverse volte. Ho la necessità di sostituire tutti i simboli di tutti i disegni con altri, utilizzando lo stesso punto di inserimento e la stessa rotazione (il nuovo simbolo è identico al vecchio, ma ha un attributo che l'altro non ha). Ho creato il nuovo simbolo in un disegno a parte e lo inserisco nel disegno da modificare, utilizzando le caratteristiche di rotazione ed inserimento del simbolo precedente. Oltre a questo ho una parte della procedura dedicata a recuperare un valore di un attributo di un altro blocco ed associarlo al simbolo che ho inserito nuovo.
Il problema che mi ritrovo ora è dovuto alla cancellazione dei simboli (sia quello che ho sostituito sia quello dal quale ho ripreso il valore dell'attributo). Se inserisco le righe per la cancellazione dei simboli nella routine FOR...EACH...NEXT ottengo ad un certo punto un "Automation error" (che ritengo sia dovuto al fatto che cancello una entità cui una mia variabile sta puntanto). Non sono riuscito a capire come risolvere decentemente il problema, quindi ho dovuto optare per cancellare i simboli con un altro ciclo for..each..next (per un tipo di simbolo, che posso cancellare senza problemi) mentre del secondo simbolo (quello dal quale recupero il valore dell'attributo) non posso cancellare tutte le istanze e al momento ho risolto facendo selezionare i simboli dall'utente e cancellandoli.

Potete aiutarmi a migliorare il codice per favore, riuscendo magari a cancellare i simboli all'atto del loro utilizzo?

Grazie ancora
Pierpaolo


incollo il codice che ho prodotto:
(alcune righe sono volutamente in modalità di commento)


'On Error GoTo FINE
'On Error Resume Next
Dim ENT As AcadEntity 'Entità cercata
Dim EntN As AcadBlockReference 'Entità Nuova
Dim EntN_Att As Variant 'Attributo del blocco nuovo
Dim EntV As AcadBlockReference 'Entità Vecchia
Dim PInserimento(2) As Double 'unto di inserimento della nuova cieca
Dim Rotazione As Double 'Angolo di rotazione della cieca
Dim Nomefile As String 'Nome del file della nuova cieca
Dim Ellisse As AcadEntity 'Entità ellisse
Dim Ellisse_Att As Variant 'Attributo dell'ellisse
Dim PPoint As Variant 'Punto preso
Dim Valore As String 'Nome della cieca
Dim Pickbox As Integer 'Memorizzo il valore della variabile di autocad PickBox
Dim SSet As AcadSelectionSet

Me.Hide

Pickbox = ThisDrawing.GetVariable("PICKBOX")
'***** INIZIO LA PROCEDURA.
'Dò per scontato che tutti i disegni siano stati aperti
Do
'Nomefile = "C:\_LAVORO\Piani di Ciecatura\SimbCieca.dwg"
Nomefile = "G:\_Cieche\SimbCieca.dwg"
'***** INSERISCO I SIMBOLI NUOVI E RIUTILIZZO IL VALORE DELLA CIECA
For Each ENT In ThisDrawing.ModelSpace
If ENT.ObjectName = "AcDbBlockReference" Then 'Controllo se è un blocco.
If ENT.Name = "Cieca" Then 'Non posso fare il controllo con AND perchè non tutti gli elementi hanno una proprietà 'name'
Set EntV = ENT

'Imposto il punto di inserimento del nuovo blocco e l'angolo di rotazione
PInserimento(0) = EntV.InsertionPoint(0)
PInserimento(1) = EntV.InsertionPoint(1)
PInserimento(2) = EntV.InsertionPoint(2)
Rotazione = EntV.Rotation

'Inserisco il nuovo simbolo
Set EntN = ThisDrawing.ModelSpace.InsertBlock(PInserimento, Nomefile, 1, 1, 1, Rotazione)

'Zoom sul simbolo nuovo, per recuperare il numero di cieca
'l'angolo di rotazione è lo stesso del blocco dell'ellisse
'muovo l'attributo nuovo nella stessa posizione di quello vecchio
ZoomCenter PInserimento, 35
EntN_Att = EntN.GetAttributes
ThisDrawing.SetVariable "PICKBOX", 40
ThisDrawing.Utility.GetEntity Ellisse, PPoint
ThisDrawing.SetVariable "PICKBOX", Pickbox
Ellisse_Att = Ellisse.GetAttributes
EntN_Att(0).TextString = Ellisse_Att(0).TextString
EntN_Att(0).Rotation = Ellisse.Rotation
EntN_Att(0).Move EntN_Att(0).TextAlignmentPoint, Ellisse_Att(0).TextAlignmentPoint

'Rigenero il disegno
ThisDrawing.Regen acAllViewports

End If
End If
Next ENT

'***** CANCELLO I VECCHI SIMBOLI *****
'SE LI CANCELLO PRIMA ENTRO IN SITUAZIONE DI ERRORE
For Each ENT In ThisDrawing.ModelSpace
If ENT.ObjectName = "AcDbBlockReference" Then
If ENT.Name = "Cieca" Then 'Or ENT.Name = "Cieca_testo" Then
'Set EntV = ENT
ENT.Delete
End If
End If
Next ENT

'***** ZOOM SU TUTTO IL DISEGNO *****
ZoomExtents


Set SSet = ThisDrawing.SelectionSets.Add("Selezione")
SSet.SelectOnScreen
For Each ENT In SSet
If ENT.ObjectName = "AcDbBlockReference" Then 'Controllo se è un blocco.
If ENT.Name = "Cieca_testo" Then 'Non posso fare il controllo con AND perchè non tutti gli elementi hanno una proprietà 'name'
ENT.Delete
End If
End If
Next ENT


ThisDrawing.Save
ThisDrawing.Close
Loop

FINE:
 

Shape

Utente Senior
Professione: Disegnatore Carpenteria
Software: Autocad, VBA-AutoLisp, Tecnometal4D, GIMP
Regione: Friuli
#5
io farei una cosa del genere

Se mi passi il tuo dvb e un file di esempio posso vedere meglio di cosa si tratta... altrimenti... con le info che ho.. più di così non saprei come e dove agire.

'On Error GoTo FINE
'On Error Resume Next
Dim ENT As AcadBlockReference 'Entità cercata
Dim EntN As AcadBlockReference 'Entità Nuova
Dim EntN_Att As Variant 'Attributo del blocco nuovo
Dim EntV As AcadBlockReference 'Entità Vecchia
Dim PInserimento(0 To 2) As Double 'unto di inserimento della nuova cieca
Dim Rotazione As Double 'Angolo di rotazione della cieca
Dim Nomefile As String 'Nome del file della nuova cieca
Dim Ellisse As AcadEntity 'Entità ellisse
Dim Ellisse_Att As Variant 'Attributo dell'ellisse
Dim PPoint As Variant 'Punto preso
Dim Valore As String 'Nome della cieca
Dim Pickbox As Integer 'Memorizzo il valore della variabile di autocad PickBox
Dim sset As AcadSelectionSet

Me.Hide

Pickbox = ThisDrawing.GetVariable("PICKBOX")

Nomefile = "G:\_Cieche\SimbCieca.dwg"



On Error Resume Next
' Delete the Selection Set if it Exists
If Not IsNull(ThisDrawing.SelectionSets.Item("ENT")) Then
Set sset = ThisDrawing.SelectionSets.Item("ENT")
sset.Delete
End If


Set sset = ThisDrawing.SelectionSets.Add("ENT")



Dim Filtertype(1) As Integer
Dim Filterdata(1) As Variant

Filtertype(0) = 0
Filterdata(0) = "insert"
Filtertype(1) = 2
Filterdata(1) = "Cieca"


sset.SelectOnScreen Filtertype, Filterdata

For Each ENT In sset

'Imposto il punto di inserimento del nuovo blocco e l'angolo di rotazione
PInserimento(0) = ENT.InsertionPoint(0)
PInserimento(1) = ENT.InsertionPoint(1)
PInserimento(2) = ENT.InsertionPoint(2)
Rotazione = ENT.Rotation

ENT.Delete

'Inserisco il nuovo simbolo
Set EntN = ThisDrawing.ModelSpace.InsertBlock(PInserimento, Nomefile, 1, 1, 1, Rotazione)

ZoomCenter PInserimento, 35
EntN_Att = EntN.GetAttributes
ThisDrawing.SetVariable "PICKBOX", 40
ThisDrawing.Utility.GetEntity Ellisse, PPoint
ThisDrawing.SetVariable "PICKBOX", Pickbox
Ellisse_Att = Ellisse.GetAttributes
EntN_Att(0).TextString = Ellisse_Att(0).TextString
EntN_Att(0).Rotation = Ellisse.Rotation
EntN_Att(0).Move EntN_Att(0).TextAlignmentPoint, Ellisse_Att(0).TextAlignmentPoint

'Rigenero il disegno
ThisDrawing.Regen acAllViewports

Next ENT
 

thetmd

Utente Junior
Professione: tecnico
Software: autocad 2008, solidworks, cyclone
Regione: sardegna
#6
Grazie per la risposta, ma c'è modo di evitare la selezione degli oggetti, e di far controllare alla macro direttamente tutti i simboli da sostituire...In realtà ho già fatto, nel senso che nel fine settimana ho modificato tutti i disegni che mi servivano, cmq mi piacerebbe ottenere una macro che ha solo bisogno del 'click' di attivazione ed al resto pensa lei. Proverò a sostituire il codice della macro e vedo se si comporta meglio nella cancellazione delle entità. ;)

Grazie per la risposta
Pierpaolo
 

Shape

Utente Senior
Professione: Disegnatore Carpenteria
Software: Autocad, VBA-AutoLisp, Tecnometal4D, GIMP
Regione: Friuli
#7
Grazie per la risposta, ma c'è modo di evitare la selezione degli oggetti, e di far controllare alla macro direttamente tutti i simboli da sostituire...In realtà ho già fatto, nel senso che nel fine settimana ho modificato tutti i disegni che mi servivano, cmq mi piacerebbe ottenere una macro che ha solo bisogno del 'click' di attivazione ed al resto pensa lei. Proverò a sostituire il codice della macro e vedo se si comporta meglio nella cancellazione delle entità. ;)

Grazie per la risposta
Pierpaolo
invece di utilizzare sset.SelectOnScreen Filtertype, Filterdata

utilizzi sset.Select acSelectionSetAll, , , Filtertype, Filterdata

e lui selezione tute le entità a disegno con il filtro attivo