Ajouter des longueurs de lignes et d\'arcs

[tecnopat]

Bonjour

 

Je voudrais faire une petite commande pour ajouter les longueurs des objets sélectionnés dans un jeu de sélection. Il peut y avoir des lignes, des arcs, et des polylignes.

Voici où j'en suis :

Sub longueurtotale()

' Create the selection set

Dim sset As Object

ThisDrawing.SelectionSets("SS1").delete

Set sset = ThisDrawing.SelectionSets.Add("SS1")

 

' Prompt the user to select objects

sset.SelectOnScreen

 

' Define the variable

Dim compteur As Double

 

' Loop through all entities in the selection

' set and assign the xdata to each entity

Dim obj As AcadEntity

Dim obj2 As AcadObject

Dim Line As AcadLine

Dim arc As AcadArc

For Each obj In sset

 

MsgBox ("type de l'objet : " & obj.EntityType)

If obj2 = 19 Then

MsgBox ("ligne trouvée !!")

Line = obj

compteur = compteur + Line.Length

Else

If obj.EntityType = 4 Then

MsgBox ("arc trouvé !!")

'compteur = compteur + obj

End If

End If

 

' For Each arc In sset

' compteur = compteur + arc.ArcLength

' Next arc

' For Each Line In sset

' compteur = compteur + Line.Length

' Next Line

 

Next obj

 

MsgBox ("longueur totale :" & compteur & "m")

ThisDrawing.SelectionSets("SS1").delete

 

End Sub

 

dans ma boucle, j'aimerais tester si mon objet est une ligne, un arc, ou une polyligne, dans ce cas j'ajoute sa longueur au compteur, sinon je passe au suivant.

J 'ai un problème pour tester le type de l'objet en question, il n'y a pas de méthode pour celà quelque part ?

 

Merci d'avance...

[nazemrap]

Bonsoir,

 

En reprenant ce que tu as déjà:

 

Sub longueurtotale()
' Create the selection set
Dim sset As Object
ThisDrawing.SelectionSets("SS1").Delete
Set sset = ThisDrawing.SelectionSets.Add("SS1")

' Prompt the user to select objects
sset.SelectOnScreen

' Define the variable
Dim compteur As Double

' Loop through all entities in the selection
' set and assign the xdata to each entity
Dim obj As AcadEntity
Dim obj2 As AcadObject
Dim Line As AcadLine
Dim arc As AcadArc
Dim poly As AcadLWPolyline

For Each obj In sset
MsgBox ("type de l'objet : " & obj.EntityType)
If obj.EntityType = 19 Then
MsgBox ("ligne trouvée !!")
Set Line = obj
compteur = compteur + Line.Length
End If
If obj.EntityType = 4 Then
MsgBox ("arc trouvé !!")
Set arc = obj
compteur = compteur + arc.ArcLength
End If
If obj.EntityType = 24 Then
MsgBox ("polyligne trouvée !!")
Set poly = obj
compteur = compteur + poly.Length
End If
Next obj

MsgBox ("longueur totale :" & compteur & "m")
ThisDrawing.SelectionSets("SS1").Delete

End Sub

[tecnopat]

Merci, çà marche !!

 

J'avais oublié l'histoire du "Set" dans VB. Pour la polyligne çà marche aussi

 

A très bientôt