J'ai répondu à ce message sur les forum Autodesk et je reproduis ma réponse in french cette fois ci, histoire de faire vivre un peu mon blog qui n'a pas eu de nouveau sujet depuis plus d'un an...

La question orginale était : comment trouver la longueur d'une polyligne en vba ?

original

La réponse est assez simple, il faut sélectionner une entité dans le dessin puis trouver la propriété Longueur (Length) de cette entité. Auparavant, il faut tester l'entité pour vérifier s'il s'agit bien d'une polyligne car si on clique sur un arc de cercle par exemple, la longueur de l'arc se retrouve par sa propriété LongueurArc (ArcLength) et dans ce cas, la macro renverra une erreur.
Quitte à tester l'entité sélectionnée, autant rendre polyvalente la macro et renvoyer la longueur de l'entité sélectionnée, quelque soit le type de l'entité, pourvu qu'elle ait une longueur en unité mesurable (ce qui n'est pas le cas d'un texte par exemple, qui peut avoir une longueur en nombre de lettre, mais ce n'est pas le propos ici).

Le reste de la macro gère les erreurs imprévues ou lorsque on clique dans le vide ou qu'on presse la touche "Echappement" pour arrêter la macro lors de la sélection de l'entité.

Code :


Option Explicit

Sub LongueurCourbes()
Dim oEntite As AcadEntity
Dim P1 As Variant
Dim strMessage As String

'Gestion des erreurs :
On Error GoTo Err_LongueurCourbes

    'Sélection de l'entité à mesurer
    ThisDrawing.Utility.GetEntity oEntite, P1, vbCrLf & "Selectionner une ligne, un arc, un cercle ou une polyligne (2D or 3D)"

    'En fonction du type de l'entité (ObjectName)
    Select Case oEntite.ObjectName
        Case "AcDbCircle"
            'On indique le type d'objet (un cercle) puis son périmètre dans la variable strMessage
            strMessage = "Cercle : " & oEntite.Circumference

        Case "AcDbArc"
            'On indique le type d'objet (un arc) puis sa longueur dans la variable strMessage
            strMessage = "Arc : " & oEntite.ArcLength

        Case "AcDbLine"
            'On indique le type d'objet (une ligne) puis sa longueur dans la variable strMessage
            strMessage = "Ligne : " & oEntite.Length

        Case "AcDbPolyline"
            'On indique le type d'objet (une polyligne 2D) puis sa longueur dans la variable strMessage
            strMessage = "Polyligne : " & oEntite.Length

        Case "AcDb3dPolyline"
            'On indique le type d'objet (une polyligne 3D) puis sa longueur dans la variable strMessage
            strMessage = "Polyligne 3D : " & oEntite.Length

        Case Else
            'Autre cas si l'entité sélectionnée n'est pas ce qu'on attend
            strMessage = "Erreur ! L'entité sélectionnée n'est pas une ligne, un arc, un cercle ou une polyligne."
    End Select


'Sortie de la macro
Exit_LongueurCourbes:
    'On écrit sur la ligne de commande le message concocté plus haut, ou, si une serreur s'est produite, le message d'erreur
    ThisDrawing.Utility.Prompt strMessage
    'On libère la mémoire de l'objet entité
    Set oEntite = Nothing
    'Puis on quitte la macro
    Exit Sub

'Gestion des erreurs
Err_LongueurCourbes:
    'L'erreur -2147352567 correspond à l'erreur si la touche Echappement est pressée ou si rien n'a été sélectionné
    'Dans ce cas, on ne renvoie pas le message d'erreur, on sort simplement de la macro.
    If Err.Number <> -2147352567 Then
        strMessage = "Erreur : " & Err.Description
    End If
    GoTo Exit_LongueurCourbes
End Sub


Merci à Coloration syntaxique vb/vba/vb.net pour la mise en forme de ce code.

Comme toujours, n'hésitez pas à commenter ce code :)