Remplacer un bloc par un autre

Aujourd'hui, je vous propose de remplacer un bloc par un autre bloc via une macro en vba.

J'ai écrit cette macro car ma société suite à un rachat, vient de changer de nom et j'ai été chargé de remplacer le logo de mon ancienne boite par le nouveau logo et ceci, dans tous les cartouches concernant notre affaire courante. Ca représente environ 300 fichiers ! L'intérêt d'automatiser la tâche m'est tout de suite venu à l'esprit, je ne sais pas pourquoi :)

Notre ancien logo est un bloc "LOGO1" inséré dans un bloc cartouche. Je vais devoir le remplacé par le nouveau logo, qui est un dessin AutoCAD enregistré sur mon disque dur sous le nom "LOGO2.dwg". Son adresse complète est "C:\LOGO2.dwg" mais il aurait pu être n'importe où ailleurs ;)

Chose importante, ce nouveau logo a été enregistré de telle façon que sa position soit correcte dès qu'on insère ce nouveau logo dans le bloc de l'ancien logo. De cette façon, la macro n'a pas à positionner le nouveau bloc dans l'ancien : le point de référence du nouveau bloc est le même que l'ancien bloc.
Le plus simple pour le faire, c'est partir d'un dessin vide, insérer le premier bloc, celui qui sera à remplacer, et le placer au point 0,0,0 du dessin. Ensuite, insérer le nouveau bloc et le positionner sur le premier bloc, à la bonne échelle et à la bonne place.
Ceci fait, supprimer le premier bloc, exploser si ce n'est pas déjà fait le deuxième bloc. Vérifier que le calque 0 soit activé, purger le dessin de tous les éléments inutiles et sauvegarder ainsi votre dessin (dans mon exemple sous C:\LOGO2.dwg).

Si j'avais du faire le travail à la main, voici comment j'aurais procédé :

1. Edition du bloc contenant l'ancien logo (bloc1)
2. Effacement de tous les éléments contenu dans le blocs
3. Insertion du bloc contenant le nouveau logo (bloc2)
4. Explosion de ce nouveau bloc (bloc2) pour éviter une arborescence inutile, c'est plus propre
5. Sortie en sauvegardant du bloc (bloc1) contenant le nouveau logo
6. Purge du dessin pour effacer le bloc contenant le nouveau logo (bloc2)
7. Renommage du bloc2  par le nom du nouveau logo.

C'est ce qui est fait par le code vba ci-dessous :

---

Sub RemplaceLogo()
Dim strLogo1 As String
Dim strLogo2 As String
Dim strNom As String
Dim bloc1 As AcadBlock
Dim bloc2 As AcadBlock
Dim refBloc2 As AcadBlockReference
Dim oEnt As AcadEntity
Dim pntInsert(0 To 2) As Double

'Initialisation des variables (à adapter en fonction des blocs à remplacer/inserer
strLogo1 = "LOGO1"
strLogo2 = "C:\LOGO2.dwg"

'Identifie de bloc à remplacer (bloc1)
Set bloc1 = ThisDrawing.Blocks(strLogo1)

'Détermination du point d'insertion du bloc 1
pntInsert(0) = bloc1.Origin(0)
pntInsert(1) = bloc1.Origin(1)
pntInsert(2) = 0

'Effacement de tous les éléments contenus dans le premier bloc
For Each oEnt In bloc1
    oEnt.Delete
Next

'Insertion du bloc2 dans le bloc1 = insertion d'une référence de bloc
Set refBloc2 = ThisDrawing.Blocks(strLogo1).InsertBlock(pntInsert, strLogo2, 1#, 1#, 1#, 0)

'Récupérer le nom du bloc2
strNom = refBloc2.Name

'Exploser le bloc2 qui est dans le bloc1
refBloc2.Explode
'Supprimer le bloc2 qui reste dans le bloc1 malgré l'Explode
refBloc2.Delete
'Purger le dessin du bloc2
Set bloc2 = ThisDrawing.Blocks(strNom)
bloc2.Delete
'Renommage du bloc1 par le nom du bloc2
bloc1.Name = strNom

'Suppression des objets en mémoire
Set bloc1 = Nothing
Set bloc2 = Nothing
Set refBloc2 = Nothing
Set oEnt = Nothing

'Régénération du dessin
ThisDrawing.Regen (acAllViewports)
End Sub

---

Chez moi ça marche, avec une version AutoCAD 2005. Il se peut que vous rencontriez des problèmes de plantages d'ACAD lorsque vous tenterez d'insérer le bloc2, à la ligne

Set refBloc2 = ThisDrawing.Blocks(strLogo1).InsertBlock(pntInsert, strLogo2, 1#, 1#, 1#, 0)

C'est un problème apparement connu qui serait lié à un mauvais driver de carte graphique. Faire une recherche sur Google, je ne peux vous en dire plus.

Vous avez également remarqué que cette macro ne comporte aucun gestionnaire d'erreur, mais on pourrait imaginer des sécurités testant l'existence du bloc à remplacer par exemple.

N'hésitez pas à poster vos commentaires, la connaissance ne vaut que si elle est partagée ! ;)

Comments

[acad386]

VB Sorts text screen ditto text block in



hello

in autocad block 4 line TXT

TXT1 (handle # 3)

TXT2 (handle # 2)

TXT3 (handle No. 4)

TXT4 (handle # 1)



When I recuper the string in a combobox it puts me in the order of handle

TXT4,2,1,3

I then I want in the order of the line screen TXT1,2,3,4



Thank you for your help

********

Bonjour

Dans le bloc autocad 4 lignes de TXT

TXT1 (handle N°3)

TXT2 (handle N°2)

TXT3 (handle N°4)

TXT4 (handle N°1)



Quand je recupere le string dans une combobox il me le met dans l'ordre du handle =>Ligne 4,2,1,3

alors que je je veux dans l'ordre de l'écran ligne 1,2,3,4



Merci pour votre aide



Public Sub LireTxt()

Dim objBloc As AcadBlock

Dim objEnt As AcadEntity

Dim objEntTxT As as AcadText



ThisDrawing.Utility.GetEntity objBlocRef, Pt1, "Sélectionnez le bloc à modifier :"

Set objBloc = ThisDrawing.Blocks(objBlocRef.Name)



For Each objEnt In objBloc

If objEnt.ObjectName = "AcDbText" Then

ListBoxTxt.AddItem objEntTxT.textString

Endif

Next



End Sub