Déplacement des attributs en VBA

[rlapt]

Bonjour,

 

Je souhaite remplacer de façon automatique (VBA) certains blocs de mon dessin par de nouveaux blocs.

 

Pour le remplacement du bloc et des textes des attributs pas de problème ça fonctionne.

 

Mon problème est le suivant :

La position des attributs et leur point d'insertion ne sont pas forcément identiques sur les nouveaux blocs par rapport aux anciens. Cela fait désordre à l'affichage.

 

J'ai essayé de remplacer le point d'insertion des attributs des nouveaux blocs par celui des anciens. Ce n'est pas bon.

 

Quelqu'un aurait il une solution pour ce problème ?

 

Merci d'avance.

[punky0147]

Peux tu expliquer plus présisément pourquoi ce n'est pas bon quand tu remplaces les points d'insertions des attributs du nouveau bloc par celui des anciens ?

[rlapt]

Bonsoir

 

Merci de votre intérêt pour mon problème.

 

En fait, il y a plusieurs causes au fait qu'il soit nécessaire de déplacer les attributs d'un bloc de remplacement :

a) La position des attributs dans le bloc de remplacement ne sont pas forcément identique.

b) l'opérateur à peut être déplacé les attributs de l'ancien bloc pour des questions de présenation.

 

Après tests et essais, le problème vient de la réponse de la fonction getboundingbox de l'ancien bloc, qui répond 0,0,0 aux deux points (voir listing ci'-dessous).

 

Je vous soumets ces lignes de code. Si vous avez une idée du pourquoi la réponse, cela m'arrangerait.

 

Merci d'avance.

----corps de l'application-----------------------

AncAttribut = AncBlock.GetAttributes()

NouvAttribut = NouvBlock.GetAttributes()

If UBound(AncAttribut) > UBound(NouvAttribut) Then

NombreAttribut = UBound(NouvAttribut)

Else

NombreAttribut = UBound(AncAttribut)

End If

NouvBlock.Update

AncBlock.Update

For I = 0 To NombreAttribut

NouvAttribut(I).TextString = AncAttribut(I).TextString

EchangePlaceAttributs AncAttribut(I), NouvAttribut(I), AncAttribut

Next

 

----Suite du corps de l'application-----------------------

 

Sub EchangePlaceAttributs(AncAttrib As Variant, NouvAttrib As Variant, AncienBloc As Variant)

Dim ABPtminCadre(2) As Double, ABPtmaxCadre(2) As Double, ABInsertionPoint As Variant

Dim NBPtminCadre As Variant, NBPtmaxCadre As Variant, NBInsertionPoint As Variant, Flag As Boolean

Dim ACentre(2) As Double, Ncentre(2) As Double

 

'pour éviter une erreur dans la fonction GetBoundingBox

If AncAttrib.TextString = "" Then

AncAttrib.TextString = "zyxwvtsrqp"

NouvAttrib.TextString = "zyxwvtsrqp"

Flag = True

End If

 

Call AncAttrib.GetBoundingBox(ABPtminCadre, ABPtmaxCadre)

'Cette fonction répond 0,0,0 aux deux variables

Call NouvAttrib.GetBoundingBox(NBPtminCadre, NBPtmaxCadre)

ABInsertionPoint = AncAttrib.InsertionPoint

NBInsertionPoint = NouvAttrib.InsertionPoint

For I = 0 To 2

ACentre(I) = (ABPtminCadre(I) + ABPtmaxCadre(I)) / 2

Ncentre(I) = ((NBPtminCadre(I) + NBPtmaxCadre(I)) / 2)

Next

Call NouvAttrib.Move(Ncentre, ACentre)

If Flag = True Then

AncAttrib.TextString = ""

NouvAttrib.TextString = ""

End If

 

 

[rlapt]

Bonjour,

 

Juste pour info.

 

le problème venait de la déclration des variables :

Dim ABPtminCadre(2) As Double, ABPtmaxCadre(2) As Double

qui sont utilisées dans la fonction getboundingbox. pour que celle-ci fonctionne il faut absolument les déclarer en tant que variables Variant.

 

Comme quoi la copie de partie de programme sans réfléchier n'a pas que des avantages.