Je me jète à l\'eau

[winfield]

Bonjour,

Je m'essaye au vba mais, j'aurai besoin d'une bonne âme charitable qui

me dise si j'écrit pas trop de bêtise. :(

 

Voilà mon 1er TP :

 

Sub Pente()
'Samedi 20/08/2005

   Dim retAngle As Double
   Dim objTexte As AcadText
   Dim PtTxt As Variant
   Dim strTexte As String
   Dim PtInsertTxt(0 To 2) As Double
   'Dim dimObj As AcadDimAligned
   On Error Resume Next
   
   With ThisDrawing.Utility
       retAngle = ThisDrawing.Utility.GetAngle(, "Sélectionné le premier point: ")
           repAngle = Format(Tan(retAngle) * 100, "0.00")
           If repAngle < 0 Then
               repAngle = repAngle * -1
           End If
           MsgBox repAngle
           PtTxt = .GetPoint(, "indiqué le point d'insertion du texte")
           PtX = PtTxt(0): PtY = PtTxt(1)
           'MsgBox PtX & "," & PtY
           PtInsertTxt(0) = PtX: PtInsertTxt(1) = PtY
           strTexte = "Pente " & repAngle & " %"
       Set objTexteobject = ThisDrawing.ModelSpace.AddText(strTexte, PtInsertTxt, 5)
       objTexteobject.Rotation = retAngle
   End With
End Sub 

 

....soyez pas trop dur hein ?!! :P

[winfield]

Hé flûte !!!!

Si je suis dans un scu, ça prend quand même par rapport au scg :mad:

Y a--t-il un équivalent à GetAngle mais qui prend par rapport au scu ?

[didier]

Bonjour,

je fais donc partie des âmes charitables,

ben ça alors, tu m'en vois ravi :)

 

Etudie ce bout de code qui va dans le sens de ton besoin

il fonctionne tout le temps, mais avec des lignes

puisque tu veux travailler, je te suggère de l' améliorer

pour que lorsque la pente est de 0 il soit écrit "HORIZONTAL"

idem pour le cas "VERTICAL"

la balle est dans ton camp.

Une dernière chose, fais attention à l'orthographe dans les invites,

ça la fout mal de voir des fautes,

l'utilisateur se pose des questions sur le programmeur...

Sub EcrirePente()

Dim P1 As Variant, P2 As Variant, P3 As Variant

Dim EntLigne As AcadLine

Dim Pi As Double

Pi = 4 * Atn(1)

Dim EntTexte As AcadText

 

' ne fonctionne qu'avec des lignes

'à toi de mettre un filtre

ThisDrawing.Utility.GetEntity EntLigne, Point, "Sélectionnez une LIGNE ..."

If EntLigne.EntityType = acLine Then

P1 = EntLigne.StartPoint

P2 = EntLigne.EndPoint

Else

MsgBox "il faut sélectionner une LIGNE"

End

End If

'Position de l'écriture

PointX = ThisDrawing.Utility.TranslateCoordinates(Point, acWorld, acUCS, False)

P3 = ThisDrawing.Utility.GetPoint(Point, "Où est ce que je vais mettre cette Pente ?...")

 

 

'calcul de la pente

pointx1 = ThisDrawing.Utility.TranslateCoordinates(P1, acWorld, acUCS, False)

pointx2 = ThisDrawing.Utility.TranslateCoordinates(P2, acWorld, acUCS, False)

 

alpha = ThisDrawing.Utility.AngleFromXAxis(pointx1, pointx2)

If alpha > Pi Then alpha = alpha - Pi

tg = Abs(Tan(alpha)) ' pente locale

signe = Sgn(alpha): If signe = 0 Then signe = 1

 

alpha = ThisDrawing.Utility.AngleFromXAxis(P1, P2)

If alpha > Pi Then alpha = alpha - Pi

 

' HauteurTexte du texte

PointX = ThisDrawing.Utility.TranslateCoordinates(P3, acWorld, acUCS, False)

HauteurTexte = ThisDrawing.Utility.GetDistance(PointX, "Hauteur du texte :")

 

Set EntTexte = ThisDrawing.ModelSpace.AddText(Format(tg, "0.0##%"), P3, HauteurTexte)

If (alpha > Pi / 2) Then

EntTexte.Rotation = alpha - Pi

Else

EntTexte.Rotation = alpha

EntTexte.HorizontalAlignment = acHorizontalAlignmentCenter

EntTexte.VerticalAlignment = acVerticalAlignmentBottom

EntTexte.TextAlignmentPoint = P3

EntTexte.StyleName = ThisDrawing.ActiveTextStyle.Name

EntTexte.ScaleFactor = ThisDrawing.ActiveTextStyle.Width

EntTexte.Update

End If

 

End Sub

 

Amicalement

 

 

[didier]

Bonjour,

 

En relisant, il apparaît une redondance :

 

[surligneur]With ThisDrawing.Utility[/surligneur]

retAngle = ThisDrawing.Utility.GetAngle(, "Sélectionné le premier point: ")

 

si tu commences par

With ThisDrawing.Utility

ensuite tu n'y fais plus appel

With ThisDrawing.Utility

.getangle "Sélectionnez le premier point: "

ensuite tu peux continuer...

puis

end with

 

amicalement

[winfield]

:o Bé y a du boulot ...............

 

Bonjour et merci Didier.

 

Je vais essayé d'analyser tout ça, mais ma première question est :

Pourquoi les "END IF" ne sont pas au même nombre que les "IF" ? ????

J'avais cru comprendre qu'il fallait que ça le soit :casstet:

 

Une dernière chose, fais attention à l'orthographe dans les invites,

ça la fout mal de voir des fautes,

l'utilisateur se pose des questions sur le programmeur...

 

Oups ! ;)

 

[Edité le 21/8/2005 par winfield]

[winfield]

Bonjour Didier,

 

Je me suis basé sur l'exemple que tu m'as filé.

 

J'ai rechangé le début, le fait de passer seulement par une ligne ne me convenant pas même si, comme tu m'as soufflé, on puisse mettre un filtre pour que ça fonctionne également avec une polyligne par exemple, mais je garde cette exercice pour plus tard.

De plus la "ligne" en question peut faire partie d'un bloc, ce qui fait encore un exercice en plus... pour apprendre à utiliser "GetSubEntity" .

(je sens que l'apprentissage va être long).

 

Voilà ce que j'ai réussi à faire :

(en attendant, je vais voir pour insérer une une flèche de direction )

 

Sub TP_1a()
Dim PtA As Variant
Dim PtB As Variant
Dim PtC As Variant
Dim EntTexte As AcadText
On Error Resume Next
Pi = 4 * Atn(1)

With ThisDrawing.Utility

PtA = .GetPoint(, "Sélectionnez le premier point: ")
PtB = .GetPoint(, "Sélectionnez le premier point: ")

Pta1 = .TranslateCoordinates(PtA, acWorld, acUCS, False)
Ptb1 = .TranslateCoordinates(PtB, acWorld, acUCS, False)

'Position de l'écriture
PointX = .TranslateCoordinates(Ptb1, acWorld, acUCS, False)
PtC = .GetPoint(Ptb1, "Point d'insertion du texte ?")

'calcul de la pente
alpha = .AngleFromXAxis(Pta1, Ptb1)
alpha1 = alpha
If alpha > Pi Then alpha = alpha - Pi
tg = Abs(Tan(alpha)) ' pente locale
signe = Sgn(alpha): If signe = 0 Then signe = 1

' HauteurTexte du texte
PointX = .TranslateCoordinates(PtC, acWorld, acUCS, False)
hauteurtexte = .GetDistance(PointX, "Hauteur du texte ?")

alpha = .AngleFromXAxis(PtA, PtB)
If alpha > Pi Then alpha = alpha - Pi

strTexte = Format(tg, "0.00#")
'MsgBox strTexte
If strTexte = "16331778728383800" Then: strTexte = "Verticale"
If strTexte = 0# Then: strTexte = "Horizontale"

Set EntTexte = ThisDrawing.ModelSpace.AddText("Pente " & Format(strTexte, "0.00#%"), PtC, hauteurtexte)

If (alpha > Pi / 2) Then
EntTexte.Rotation = alpha - Pi
Else
EntTexte.Rotation = alpha
EntTexte.HorizontalAlignment = acHorizontalAlignmentCenter
EntTexte.VerticalAlignment = acVerticalAlignmentBottom
EntTexte.TextAlignmentPoint = PtC
EntTexte.StyleName = ThisDrawing.ActiveTextStyle.Name
EntTexte.ScaleFactor = ThisDrawing.ActiveTextStyle.Width
EntTexte.Update
End If
End With
End Sub 

 

Par contre, je n'ai pas compris :

 

Le coup des 16331778728383800 (je me suis cassé les dents dessus), je suppose que c'est une histoire avec les Pi radians non ?

Les différences dans les résultats selon si on utilise ton exemple ou le TP_1a, bien que les différences soient minimes.

[winfield]

Rectification :

 [surligneur]  strTexte = tg [/surligneur] 
'MsgBox strTexte
If strTexte =  [surligneur]"1,63317787283838E+16" [/surligneur] Then: strTexte = "Verticale" 
If strTexte = 0# Then: strTexte = "Horizontale"

Set EntTexte = ThisDrawing.ModelSpace.AddText("Pente " & Format(strTexte, "0.0#%"), PtC, hauteurtexte)

 

Et apparemment avec ça il n'y a plus d'écart.

:casstet:

 

..."Pente horizontale" ??? :o ....rien n'peut m'arrêter !!! :mad:

 

Je crois qu'un ptit dodo s'impose.

 

[Edité le 24/8/2005 par winfield]

[winfield]

Bonjour,

J'ai encore fait des modifications sur la routine :

On indique 2 points pour la pente, un point pour l'emplacement du texte et on indique pour finir la hauteur du texte qui est par défaut de 2.5 unité.

A la suite de tout ça, ça met donc un texte indiquant "Pente X %" ainsi qu'une flèche sauf dans le cas ou c'est horizontal ou vertical.

Le problème est que pour certaines pentes, la flèche se retrouve bien trop loin du texte :mad: .

Vous pouvez voir un aperçu à : http:// http://winfield-34.blogspot.com/2005/09/pente.html (un clic sur l'image pour l'agrandir).

Si qqn a une explication.... ;)

[winfield]

Oups j'avais oublié de mettre le code ;)

 

Sub Pente()
'26/08/2005

Dim PtA As Variant
Dim PtB As Variant
Dim PtC As Variant
Dim PtD As Variant
Dim EntTexte As AcadText
Dim Fleche As AcadPolyline
Dim PtFleche(0 To 5) As Double

On Error Resume Next

With ThisDrawing.Utility

Pi = 4 * Atn(1)
MsgBox Pi
PtA = .GetPoint(, "Sélectionnez le premier point: ")
PtB = .GetPoint(, "Sélectionnez le premier point: ")
PtC = .GetPoint(, "Point d'insertion du texte ?")
'Translations de coordonnées
Pta1 = .TranslateCoordinates(PtA, acWorld, acUCS, False)
Ptb1 = .TranslateCoordinates(PtB, acWorld, acUCS, False)

hTxt = .GetReal("Hauteur texte ? < 2.5 >")
If hTxt = "" Then hTxt = 2.5

'calcul de la pente
alpha = .AngleFromXAxis(Pta1, Ptb1)
If alpha > Pi Then alpha = alpha - Pi
   tg = Abs(Tan(alpha)) ' pente locale
       signe = Sgn(alpha): If signe = 0 Then signe = 1

'Direction du texte
AlphaTxt = .AngleFromXAxis(PtA, PtB)
If AlphaTxt > Pi Then AlphaTxt = AlphaTxt - Pi
MsgBox alpha
If alpha = Pi Then
   Set EntTexte = ThisDrawing.ModelSpace.AddText("Horizontal", PtC, hTxt)
       EntTexte.Rotation = AlphaTxt
           End
   ElseIf alpha = Pi / 2 Then
       Set EntTexte = ThisDrawing.ModelSpace.AddText("Vertical", PtC, hTxt)
           EntTexte.Rotation = AlphaTxt
               End
           Else
               Set EntTexte = ThisDrawing.ModelSpace.AddText("Pente " & FormatPercent(tg, 2, vbUseDefault), PtC, hTxt)
       End If
   If AlphaTxt > Pi / 2 Then
AlphaTxt = AlphaTxt + Pi
   End If
   EntTexte.Rotation = AlphaTxt

Fac1 = 3
If alpha > Pi / 2 And alpha < Pi Then: Fac1 = 13
If alpha > Pi + Pi / 2 Then: Fac1 = 13

If AlphaTxt < Pi Then
AlphaDir = AlphaTxt + Pi
   Else
   AlphaDir = AlphaTxt
       End If
varpt1 = .PolarPoint(PtC, AlphaDir, hTxt * Fac1)
varpt2 = .PolarPoint(varpt1, AlphaDir, hTxt * 4)
PtFleche(0) = varpt1(0): PtFleche(1) = varpt1(1): PtFleche(2) = 0
PtFleche(3) = varpt2(0): PtFleche(4) = varpt2(1): PtFleche(5) = 0
Set plineObj1 = ThisDrawing.ModelSpace.AddPolyline(PtFleche)

'Insertion  de la flèche
plineObj1.SetWidth 0, hTxt / 5, 0
varpt3 = .PolarPoint(varpt2, AlphaDir, hTxt)
PtFleche(0) = varpt2(0): PtFleche(1) = varpt2(1): PtFleche(2) = 0
PtFleche(3) = varpt3(0): PtFleche(4) = varpt3(1): PtFleche(5) = 0
Set plineObj2 = ThisDrawing.ModelSpace.AddPolyline(PtFleche)
plineObj2.SetWidth 0, hTxt / 2, 0
End With
End Sub

 

[Edité le 3/9/2005 par winfield]