Point d\'insertion d\'un attribut

[dr.loveless]

Salut,

 

J'ai créer un petit programme pour trouver l'angle et le point d'insertion d'un attribut, mais celui-ci bug au niveau du point d'insertion, j'ai inserer une boite de dialogue me permettant de controler ces valeurs avant de continuer le developpement du programme,

mais quand j'ajoute "Pointdinsertion" à la boite de dialogue çà plante.

 

Voilà le programme :

 

Private Sub CommandButton1_Click()

 

Dim objElem As Object ' objet Elément du dessin

 

Dim tablAttrib As Variant ' tableau des attributs

 

Dim Cptpm70 As Integer ' compteurs

Dim PtInsert As Variant ' point d'insertion du bloc

Dim attributorigine, attributfin, attributplus As String

Dim Pointdinsertion As Variant

Dim Angle As Variant

 

On Error GoTo 0

 

 

For Each objElem In ThisDrawing.ModelSpace

 

If objElem.EntityType = acBlockReference Then

 

tablAttrib = objElem.GetAttributes

 

For Cptpm70 = LBound(tablAttrib) To UBound(tablAttrib)

 

attributorigine = tablAttrib(Cptpm70).TextString

Pointdinsertion = tablAttrib(Cptpm70).InsertionPoint

Angle = tablAttrib(Cptpm70).Rotation

MsgBox "Point d'insertion = " & Pointdinsertion & "Angle = " & Angle, vbOKOnly

 

Next

 

End If

 

Next objElem

 

Unload Me

 

 

Voilà, je pense que je programme vient de la définition de ma variable" Pointdinsertion", mais j'en ai essayer plusieurs et le problèeme est tjs là.

 

 

Merci d'avance.

 

[dr.loveless]

OK, j'ai trouver la couille ,

 

 

Voici la correction :

 

Private Sub CommandButton1_Click()

 

Dim objElem As Object ' objet Elément du dessin

 

Dim tablAttrib As Variant ' tableau des attributs

 

Dim Cptpm70 As Integer ' compteurs

Dim PtInsert As Variant ' point d'insertion du bloc

Dim attributorigine, attributfin, attributplus As String

Dim Pointdinsertion As Variant

Dim Angle As Variant

 

On Error GoTo 0

 

 

For Each objElem In ThisDrawing.ModelSpace

 

If objElem.EntityType = acBlockReference Then

 

tablAttrib = objElem.GetAttributes

 

For Cptpm70 = LBound(tablAttrib) To UBound(tablAttrib)

 

attributorigine = tablAttrib(Cptpm70).TextString

Pointdinsertion = tablAttrib(Cptpm70).InsertionPoint

Angle = tablAttrib(Cptpm70).Rotation

MsgBox "Point d'insertion : " & Pointdinsertion(0) & " ; " & Pointdinsertion(1) & " ; Angle = " & Angle, vbOKOnly

 

 

 

 

Next

 

End If

 

Next objElem

 

Unload Me

 

 

End Sub

 

 

 

 

Mais maintenant il faudrait que je change le point d'insertion de l'attribut, et là, je n'ai vraiment aucune idée pour le faire.

 

Avis aux amateurs,

 

Merci

[didier]

Bonsoir LeDoc,

que souhaites tu faire ?

déplacer le bloc dans le dessin ?

en cliquant un point ?

en affectant un déplacement uniforme à toutes les occurences de ce bloc ?

en fonction de la valeur trouvée dans un attribut ?

Tout est possible si on sait où on veut aller.

Ne pouvant échanger que par du texte,

la fonction transmission de pensée étant actuellement en dérangement,

Soyons précis dans nos messages,

c'est la base d'une communication efficace.

amicalement

 

 

[dr.loveless]

Bonsoir,

 

 

Désolé pour mon manque de précision, le prog que je souhaite réaliser doit déplacer tout les attributs d'un blocs d'une certaine valeur en respectant l'orientation des attributs, simplement en lancant le programme, puis en cliquant sur l'objet, donc sans avoir à selectionner les attributs et les déplacer les uns après les autres.

 

Ce programme me servira à effectuer une présentation plus professionnelle et plus lisible, le tout plus rapidement (car je pourrais selectionner tout les blocs à mettre en page d'un seul coup).

 

A l'heure actuel j'arrive à exporter les coordonnées du point d'insertion de chaque attribut, mais pas à retourner le nouveau point d'insertion.

 

Voilà j'espère que c'est plus clair.

 

Merci

[didier]

Bonjour

c'est donc le point d'insertion du bloc qu'il faut déplacer,

tous les attributs vont suivre comme des bons petits soldats.

Puisque je m'obstine à ne pas comprendre,

je te propose de m'envoyer un message privé sur le site

je t'enverrai en retour mon mail en retour

tu pourras ainsi m'envoyer un dwg, exemple de ce que tu souhaites réaliser.

je mettrai la réponse en exemple de VBA. :yltype:

à bientôt

[dr.loveless]

Toujours pas assez précis.

 

Je developpe, Tous les attributs bougent, mais le bloc composé de lignes ne bouge pas.

 

Cooment on fait pour envoyer un message privé??

 

Je sais pas faire, je vais fouiller un peu.

 

 

Faut dormir la nuit ;-)

 

 

 

Merci

[didier]

BONJOUR !!!!

Ben pour envoyer un message privé,

c'est assez simple,

si je suis en ligne en cliquant sur mon nom

on te propose de m'envoyer ce fameux message privé.

Si ce n'est pas le cas, dans la liste des membres

tu auras la même possibilité.

On pourra échanger nos courriel

pour faire des dwg exemples.

En souhaitant que la communication sera plus aisée.

En final, si je te fais un programme,

je le mettrai en tutorial de VBA,

pour que la communauté en profite...

bonne journée

[dr.loveless]

Re,

 

 

Bon j'y arrive pas, mon e mail : fdumand@caramail.com

 

Je pense qu'il sera plus simple de transmettre le dwg par e mail, chui neuneu dsl.

 

 

 

 

Voilà le code à l'heure actuelle :

 

Dim objElem As Object ' objet Elément du dessin

 

Dim tablAttrib As Variant ' tableau des attributs

 

Dim Cptpm70 As Integer ' compteurs

Dim PtInsert As Variant ' point d'insertion du bloc

Dim Pointdinsertion As Variant

Dim Angle As Variant

Dim NouvPtInsert(0 To 2) As Double

 

 

 

On Error GoTo 0

 

 

For Each objElem In ThisDrawing.ModelSpace

 

If objElem.EntityType = acBlockReference Then

 

tablAttrib = objElem.GetAttributes

 

For Cptpm70 = LBound(tablAttrib) To UBound(tablAttrib)

 

' Affecte le point d'insertion de l'attribut à la variable Pointdinsertion

 

Pointdinsertion = tablAttrib(Cptpm70).InsertionPoint

 

' Affecte la rotation de l'attribut à la variable Angle '

 

Angle = tablAttrib(Cptpm70).Rotation

 

' Affecte la nouvelle rotation à l'attribut en retournant la valeur 0 dans la table '

' fonctionne'

 

tablAttrib(Cptpm70).Rotation = 0

 

' Affecte le nouveau point d'insertion à l'attribut en retaournant la valeur calculée dans la table'

' Ne fonctionne pas'

 

NouvPtInsert(0) = Pointdinsertion(0) - 100

NouvPtInsert(1) = Pointdinsertion(1)

NouvPtInsert(2) = Pointd'insertion(2)

tablAttrib(Cptpm70).InsertionPoint = NouvPtInsert

 

Next

 

End If

 

Next objElem

 

 

 

Ce que je ne comprends pas, c'est pourquoi la rotation s'effectue bien, à savoir si l'attribut est incliné, il est automatiquement remis droit, tandis que les attributs ne sont pas déplacés de 100 unités vers le bas.

 

Ce qui me saoule, c'est que le programme ne bug pas, il arrive donc bien à interpreter la commande !!!

 

Merci