ajuster des lignes

[jdsv]

bonsoir,

voici mon problème

Je tracer des lignes grâce au code suivant :

 Sub ligne(x1, y1, X2, y2)
   Dim P1(0 To 2) As Double
   Dim P2(0 To 2) As Double
   P1(0) = Log10(x1) * Correction_axe_x
   P1(1) = Log10(y1)
   P1(2) = 0
   P2(0) = Log10(X2) * Correction_axe_x
   P2(1) = Log10(y2)
   P2(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(P1, P2)
End Sub

 

Et je voudrais que les ségments tracer soit :

- si il sont dans les limites tracer

- si ils sont a cheval sur les limites ajuster

- si sont hors des limites ne pas les tracer

les limites sont définies par X_maxi, Y_maxi, X_min, Y_maxi qui sonts des variable pubic

 

j''ai commencé à tavailler sur le code mais je m'égard dans les tests qui s'imbrique

 

merci de votre aide

 

[Edité le 17/8/2007 par jdsv]

[sechanbask]

J'ai un peu de mal à comprendre ce que tu veux faire. Soit clair et parle français s'il te plait.

[punky0147]

je pense répondre à tes attentes avec le code suivant, certains trouveront peut-être ca un peu bourrin, c'est certainement optimisable, je l'ai fait vite fait :

 

Sub ligne(x1, y1, X2, y2)

Dim sel As AcadSelectionSet

Dim P1(0 To 2) As Double

Dim P2(0 To 2) As Double

Dim listpoint(0 To 9) As Double

Dim interpoints As Variant

Dim intcodes(0) As Integer

Dim varvaleurs(0) As Variant

Dim ob As Object

 

Correction_axe_x = 1

 

P1(0) = Log(x1) * Correction_axe_x

P1(1) = Log(y1)

P1(2) = 0

P2(0) = Log(X2) * Correction_axe_x

P2(1) = Log(y2)

P2(2) = 0

listpoint(0) = X_min

listpoint(1) = Y_min

listpoint(2) = X_min

listpoint(3) = Y_maxi

listpoint(4) = X_maxi

listpoint(5) = Y_maxi

listpoint(6) = X_maxi

listpoint(7) = Y_min

listpoint(8) = X_min

listpoint(9) = Y_min

 

Set zone = ThisDrawing.ModelSpace.AddLightWeightPolyline(listpoint)

Set point1 = ThisDrawing.ModelSpace.AddPoint(P1)

Set point2 = ThisDrawing.ModelSpace.AddPoint(P2)

point1.Update

point2.Update

zone.Update

 

 

deja = 0

For Each sel In ThisDrawing.SelectionSets

If sel.Name = "test" Then

deja = 1

End If

Next sel

 

If deja = 0 Then

Set sel = ThisDrawing.SelectionSets.Add("test")

End If

Set sel = ThisDrawing.SelectionSets("test")

sel.Clear

 

intcodes(0) = 0

varvaleurs(0) = "POINT"

P1(0) = X_min

P1(1) = Y_maxi

P1(2) = -1000

P2(0) = X_maxi

P2(1) = Y_min

P2(2) = 1000

 

sel.Select acSelectionSetWindow, P1, P2, intcodes, varvaleurs

p1ok = 0

p2ok = 0

 

For Each ob In sel

If point1.Handle = ob.Handle Then

p1ok = 1

End If

If point2.Handle = ob.Handle Then

p2ok = 1

End If

Next ob

 

Set lineobj = ThisDrawing.ModelSpace.AddLine(point1.Coordinates, point2.Coordinates)

interpoints = zone.IntersectWith(lineobj, acExtendNone)

 

If UBound(interpoints) <> -1 Then

If p1ok + p2ok = 0 Then

lineobj.Delete

P1(0) = interpoints(0)

P1(1) = interpoints(1)

P1(2) = interpoints(2)

P2(0) = interpoints(3)

P2(1) = interpoints(4)

P2(2) = interpoints(5)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, P2)

End If

If p1ok = 0 And p2ok = 1 Then

lineobj.Delete

P1(0) = interpoints(0)

P1(1) = interpoints(1)

P1(2) = interpoints(2)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, point2.Coordinates)

End If

If p1ok = 1 And p2ok = 0 Then

lineobj.Delete

P1(0) = interpoints(0)

P1(1) = interpoints(1)

P1(2) = interpoints(2)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, point1.Coordinates)

End If

zone.Delete

point1.Delete

point2.Delete

lineobj.Update

Else

If p1ok + p2ok = 0 Then

zone.Delete

point1.Delete

point2.Delete

lineobj.Delete

Update

Else

zone.Delete

point1.Delete

point2.Delete

lineobj.Update

End If

End If

 

End Sub

 

dis moi si ca marche et si c'est bien ca que tu voulais

[jdsv]

bonjour,

merci punky0147,

j'ai testé ton programme, mais celui-ci plante à la ligne

 

Set point1 = ThisDrawing.ModelSpace.AddPoint(P1)

 

erreur de compilation : impossible d'affecter à un tableau

 

pour sechanbask

Voici mon problème, je génère des lignes à l’aide du programme dont le tracer de lignes se fait par le listing présenter avant.

Je voudrais que les segments tracer soit à l’intérieur d’une zone délimité par les bornes X_min, Y_mini, X_maxi et Y_maxi.

Donc 3 cas se présentent :

- le segment est à l’extérieur de la zone, on ne fait rien (on passe, au segment suivant)

- le segment est dans la zone, on trace la totalité du segment

- le segment est à cheval sur la limite de la zone, on ajuste le segment jusqu'à la limite de la zone.

 

J’espère avoir été plus clair

merci de votre aide

 

[punky0147]

chez moi pas de plantage. tu aurais pas une variable globale de déclarée qui s'appellerait point1 ? (un tableau...) je dis peut-être une bétise, mais je vois pas d'ou ca peut venir ce message d'erreur sinon.... j'sais pas trop, essaye de voir de ton coté, au pire, essaye en rennomant ma variable point1 par un autre nom... tiens moi au courant

[jdsv]

bonjour punky0147

j'ai lancé le programme dans un autre fichier et cela ne plante pas.

je pense que je ne suis plus trés loin de la solution car les lignes sont bien testées, mais elle ne sont pas tracées.

Peut tu commenter le listing que tu m'as envoyé SVP

 

Merci

[punky0147]

je comprends pas trop pourquoi ca ne marche pas chez toi, moi pour le peux que j'ai testé (4 cas possibles), j'ai pas une erreur, et les lignes sont tracées quand il le faut, ajustées quand il le faut. Je commente un peu le code alors :

 

Sub ligne(x1, y1, X2, y2)

Dim sel As AcadSelectionSet

Dim P1(0 To 2) As Double

Dim P2(0 To 2) As Double

Dim listpoint(0 To 9) As Double

Dim interpoints As Variant

Dim intcodes(0) As Integer

Dim varvaleurs(0) As Variant

Dim ob As Object

 

Correction_axe_x = 1 'la je met juste la valeur à un, c'était pour moi, pour le tester

 

P1(0) = Log(x1) * Correction_axe_x

P1(1) = Log(y1)

P1(2) = 0

P2(0) = Log(X2) * Correction_axe_x

P2(1) = Log(y2)

P2(2) = 0

 

'Toutes les coordonnées vont servir à tracer une polyligne dénissant les limites du tracé

listpoint(0) = X_min

listpoint(1) = Y_min

listpoint(2) = X_min

listpoint(3) = Y_maxi

listpoint(4) = X_maxi

listpoint(5) = Y_maxi

listpoint(6) = X_maxi

listpoint(7) = Y_min

listpoint(8) = X_min

listpoint(9) = Y_min

 

 

'on créé trois éléments :

'zone, qui est une polyligne représentant les limites du tracé

'point1, qui est le point de départ de ta ligne (qui sera testé par la suite)

'point2, qui est le point de terminaison de ta ligne (qui sera testé par la suite)

 

Set zone = ThisDrawing.ModelSpace.AddLightWeightPolyline(listpoint)

Set point1 = ThisDrawing.ModelSpace.AddPoint(P1)

Set point2 = ThisDrawing.ModelSpace.AddPoint(P2)

point1.Update

point2.Update

zone.Update

 

 

'On vérifie si la sélection "test" existait déjà ou non

deja = 0

For Each sel In ThisDrawing.SelectionSets

If sel.Name = "test" Then

deja = 1

End If

Next sel

 

 

'Si la sélection "test" n'existait pas, on la créée

If deja = 0 Then

Set sel = ThisDrawing.SelectionSets.Add("test")

End If

Set sel = ThisDrawing.SelectionSets("test")

 

'On efface la sélection (des fois qu'elles existaient avant)

sel.Clear

 

 

'On va a présent sélectionner les objets de type "POINT" à l'intérieur des limites donnée par

'X_min, Y_min, ... (je met -1000 et 1000 en axe z, puisqu'il faut définir un espace de sélection à 3 dimensions)

 

intcodes(0) = 0

varvaleurs(0) = "POINT"

P1(0) = X_min

P1(1) = Y_maxi

P1(2) = -1000

P2(0) = X_maxi

P2(1) = Y_min

P2(2) = 1000

 

sel.Select acSelectionSetWindow, P1, P2, intcodes, varvaleurs

 

'La sélection est à présent créée, on vérifie si les points créés (point1 et point2) sont dans cette

'sélection (et donc dans la zone limite de tracage). si point1 est dedant, alors p1ok sera égal à 1

'idem pour point2 (j'utilise le handle des objets pour vérifier si ce sont bien les mêmes)

 

p1ok = 0

p2ok = 0

 

For Each ob In sel

If point1.Handle = ob.Handle Then

p1ok = 1

End If

If point2.Handle = ob.Handle Then

p2ok = 1

End If

Next ob

 

'ensuite, selon le cas, on a besoin de connaitre les coordonnées des intersections entre la zone

'délimitées et la ligne que tu veux tracer

 

'On trace donc la ligne dans un premier temps

Set lineobj = ThisDrawing.ModelSpace.AddLine(point1.Coordinates, point2.Coordinates)

 

'On récupère les coordonnées des intersections (si il y en a)

interpoints = zone.IntersectWith(lineobj, acExtendNone)

 

If UBound(interpoints) <> -1 Then 'si des intersections ont été trouvées

If p1ok + p2ok = 0 Then 'si les deux points que tu as donné sont en dehors de la zone

lineobj.Delete 'on efface la ligne tracé précédemment et on en retrace une entre

P1(0) = interpoints(0) 'les deux points d'intersections

P1(1) = interpoints(1)

P1(2) = interpoints(2)

P2(0) = interpoints(3)

P2(1) = interpoints(4)

P2(2) = interpoints(5)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, P2)

End If

If p1ok = 0 And p2ok = 1 Then 'si uniquement le point2 est dans la zone

lineobj.Delete 'on efface la ligne tracée précédemment et on en retrace une

P1(0) = interpoints(0) 'entre l'intersection trouvée et point2

P1(1) = interpoints(1)

P1(2) = interpoints(2)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, point2.Coordinates)

End If

If p1ok = 1 And p2ok = 0 Then 'si uniquement le point1 est dans la zone

lineobj.Delete 'on efface la ligne tracée précédemment et on en retrace une

P1(0) = interpoints(0) 'entre l'intersection trouvée et point1

P1(1) = interpoints(1)

P1(2) = interpoints(2)

Set lineobj = ThisDrawing.ModelSpace.AddLine(P1, point1.Coordinates)

End If

zone.Delete 'on efface la zone tracée

point1.Delete 'on efface le premier point dessiné

point2.Delete 'on efface le deuxième point dessiné

lineobj.Update

Else '(si aucune intersection n'a été trouvée)

If p1ok + p2ok = 0 Then 'si les deux points étaient en dehors de la zone, on efface tout

zone.Delete 'ce qu'on avait dessiné et on ne trace rien

point1.Delete

point2.Delete

lineobj.Delete

Update

Else 'si les deux points étaient dans la zone, on efface la zone, les

zone.Delete 'deux points, mais on conserve la ligne qui avait été tracée

point1.Delete

point2.Delete

lineobj.Update

End If

End If

 

End Sub

 

 

bon, j'suis pas très doué pour les commentaires sur les codes, j'espère que t'as saisi un peu la méthode que j'ai utilisée, je ne vois vraiment pas pk ca marche pas chez toi.... bref, redis moi si j'ai fait une bonne gaffe au milieu... c'est toujours bon à savoir

[jdsv]

Bonjour punky0147

Ca y es, cela fonctionne,

mea culpa c'etait de ma faute, a force de modifier re-modifier et de re-re-modifier, les déclarations de variables ne suivent pas.

j'ai donc adapté ton ptogramme à mes besoins (cela fonctionnent, mais il faut 20 min pour générer l'abaque) donc grace à tes commentaires je vais comprendre et tenter d'optimiser le code. (pas tout de suite, car c'est la rentrée).

 

merci beaucoup de ton aide dés que j'aurais optimisé (si je le peut) je te ferais parvenir le code

merci encore et a+

jdsv