Faire une mesure sur un objet curviligne

[bonuscad]

Bonjour,

 

J'avais besoin de réaliser des mesures de longueur sur des objets curvilignes(POLYLINE,LIGNE,ARC,CERCLE,ELLIPSE,SPLINE).

Jusqu'à maintenant c'était parfois laborieux (surtout sur des objets courbes) pour obtenir une longueur précise à partir d'un point de référence quelconque sur l'objet.

J'ai donc créé ce petit lisp pour palier à cet inconvénient, il pourra peut être vous rendre service...

 

Le point retourné sur la courbe résultante à partir de la longueur donnée depuis le point de référence sera stocké dans la variable LASTPOINT.

Ainsi, par exemple, pour tracer une ligne partant de ce point précis, il suffira d'entrer le symbole "@" au message "du point: " pour faire partir la ligne de ce point calculé.

 

Si mon discours ne vous semble pas clair, le mieux est de tester ;)

 

(defun draw_pt (pt col / rap)
 (setq rap (/ (getvar "viewsize") 50))
 (foreach n
   (mapcar
     '(lambda (x)
       (list
         ((eval (car x)) (car pt) rap)
         ((eval (cadr x)) (cadr pt) rap)
         (caddr pt)
       )
     )
     '((+ +) (+ -) (- +) (- -))
   )
   (grdraw pt n col)
 )
)
(defun c:measure_on_curve ( / js ent vla_obj param_end perim_obj op pt_ref dist_ref len_vtx new_pt key)
 (vl-load-com)
 (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une mesure.")
 (while
   (not
     (setq js
       (ssget "_+.:E:S"
         (list
           (cons -4 "<OR")
             (cons -4 "<AND")
               (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE")
               (cons -4 "<NOT")
                 (cons -4 "&") (cons 70 112)
               (cons -4 "NOT>")
             (cons -4 "AND>")
             (cons 0 "SPLINE")
           (cons -4 "OR>")
         )
       )
     )
   )
 )
 (setq
   ent (ssname js 0)
   vla_obj (vlax-ename->vla-object ent)
   param_end (vlax-curve-getEndParam vla_obj)
   perim_obj (vlax-curve-getDistAtParam vla_obj param_end)
   op '+
 )
 (redraw ent 3)
 (initget 1)
 (setq
   pt_ref (getpoint "\nPoint de référence de la mesure: ")
   pt_ref (vlax-curve-getClosestPointTo vla_obj (trans pt_ref 1 0))
 )
 (draw_pt (trans pt_ref 0 1) 1)
 (setq dist_ref (vlax-curve-getDistAtPoint vla_obj pt_ref))
 (initget 7)
 (setq len_vtx (getdist (trans pt_ref 0 1) "\nLongueur du segment: "))
 (cond
   ((<= len_vtx perim_obj)
     (if (or (null (setq new_pt (vlax-curve-getPointAtDist vla_obj (+ dist_ref len_vtx)))) (> ((eval op) dist_ref len_vtx) perim_obj))
       (setq new_pt (vlax-curve-getPointAtDist vla_obj (- dist_ref len_vtx)))
     )
     (draw_pt (trans new_pt 0 1) 3)
     (princ "\n<Click+gauche> pour additionner ou soustraire; <Entrée>/[Espace]/Click+droit pour finir!.")
     (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
       (cond
         ((eq (car key) 3)
           (if (eq op '+) (setq op '-) (setq op '+))
           (if (and (<= ((eval op) dist_ref len_vtx) perim_obj) (>= ((eval op) dist_ref len_vtx) 0.0))
             (setq new_pt (vlax-curve-getPointAtDist vla_obj ((eval op) dist_ref len_vtx)))
             (setq new_pt nil)
           )
         )
       )
       (if new_pt
         (progn (redraw) (draw_pt (trans pt_ref 0 1) 1) (draw_pt (trans new_pt 0 1) 3))
         (progn (redraw) (draw_pt (trans pt_ref 0 1) 1))
       )
     )
     (redraw)
     (if new_pt (setvar "LASTPOINT" (trans new_pt 0 1)))
   )
   (T
     (princ "\nLa longueur introduite est plus grande que l'objet.")
   )
 )
 (redraw ent 4)
 (prin1)
)

Modifié le 7 novembre 2012 par bonuscad

[-Olivier-]

Bonjour Bonuscad,

 

Tout d'abord un grand merci pour ce lisp, il fonctionne parfaitement pour les arcs, polylignes et ellipses. :)

 

En revanche lorsque j'essaye de sélectionner une spline, il continu à me demander le "Choix des objets:". Elles apparaissent pourtant bien dans le lisp ... :huh:

 

Pour information j'utilise Autocad 2011.

 

Bonne journée et encore merci.

[bonuscad]

Pas assez testé :angry:

 

Merci du retour, c'est une erreur d'inclusion sur le code 70 (pour exclure les mailles dans les polylignes) qui était la cause du problème.

J'ai modifié le code (la constitution du filtre) ci-dessus.

[-Olivier-]

Super Bonuscad, B)

 

Pas assez testé

Les splines correspondaient au cas m'interessant le plus. Du coup je suis tombé sur le bug au premier essai. :P

[lecrabe]

Hello Bruno

 

Magnifique et Merci pour la communaute !

 

Neanmoins SVP je sollicite une petite amelioration :

 

Question : Generer les Points graphiques (Defaut=O) :

Si Oui, alors tu dessines 2 points graphiques AutoCAD sur le calque courant

 

Merci d'avance pour cette routine (A ranger dans l'armoire geocodage lineaire)

J'ai teste sur un MAP 2012 32 bits ...

 

lecrabe

 

PS: en fait j'ai deja ajoute 2 lignes dans ta routine pour lui faire dessiner les 2 points

mais je suis bien incapable d'inclure dans le coeur de ta routine

le test (pour dessiner ou pas les points) provenant de ma question supplementaire

[bonuscad]

Question : Generer les Points graphiques (Defaut=O) <O/N> :

Si Oui, alors tu dessines 2 points graphiques AutoCAD sur le calque courant

 

Ta demande me semble incohérente, pourquoi?

D'abords tu me demande les 2 points, j'ai du mal à comprendre pourquoi! En plus dans certain cas, seul un point est possible (suivant la position du point de référence)

Et puis si ceux-ci ne sont pas dessinés, il ne m’aie pas possible de stocker 2 points dans la variable LASTPOINT; donc quid du résultat ?...

 

Néanmoins voici ton souhait:

(defun draw_pt (pt col / rap)
 (setq rap (/ (getvar "viewsize") 50))
 (foreach n
   (mapcar
     '(lambda (x)
       (list
         ((eval (car x)) (car pt) rap)
         ((eval (cadr x)) (cadr pt) rap)
         (caddr pt)
       )
     )
     '((+ +) (+ -) (- +) (- -))
   )
   (grdraw pt n col)
 )
)
(defun c:measure_on_curve ( / js ent vla_obj param_end perim_obj op pt_ref dist_ref len_vtx new_pt key)
 (vl-load-com)
 (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une mesure.")
 (while
   (not
     (setq js
       (ssget "_+.:E:S"
         (list
           (cons -4 "<OR")
             (cons -4 "<AND")
               (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE")
               (cons -4 "<NOT")
                 (cons -4 "&") (cons 70 112)
               (cons -4 "NOT>")
             (cons -4 "AND>")
             (cons 0 "SPLINE")
           (cons -4 "OR>")
         )
       )
     )
   )
 )
 (setq
   ent (ssname js 0)
   vla_obj (vlax-ename->vla-object ent)
   param_end (vlax-curve-getEndParam vla_obj)
   perim_obj (vlax-curve-getDistAtParam vla_obj param_end)
   op '+
 )
 (redraw ent 3)
 (initget 1)
 (setq
   pt_ref (getpoint "\nPoint de référence de la mesure: ")
   pt_ref (vlax-curve-getClosestPointTo vla_obj (trans pt_ref 1 0))
 )
 (draw_pt (trans pt_ref 0 1) 1)
 (setq dist_ref (vlax-curve-getDistAtPoint vla_obj pt_ref))
 (initget 7)
 (setq len_vtx (getdist (trans pt_ref 0 1) "\nLongueur du segment: "))
 (cond
   ((<= len_vtx perim_obj)
     (if (or (null (setq new_pt (vlax-curve-getPointAtDist vla_obj (+ dist_ref len_vtx)))) (> ((eval op) dist_ref len_vtx) perim_obj))
       (setq new_pt (vlax-curve-getPointAtDist vla_obj (- dist_ref len_vtx)))
     )
     (draw_pt (trans new_pt 0 1) 3)
     (princ "\n<Click+gauche> pour additionner ou soustraire; <Entrée>/[Espace]/Click+droit pour finir!.")
     (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
       (cond
         ((eq (car key) 3)
           (if (eq op '+) (setq op '-) (setq op '+))
           (if (and (<= ((eval op) dist_ref len_vtx) perim_obj) (>= ((eval op) dist_ref len_vtx) 0.0))
             (setq new_pt (vlax-curve-getPointAtDist vla_obj ((eval op) dist_ref len_vtx)))
             (setq new_pt nil)
           )
         )
       )
       (if new_pt
         (progn (redraw) (draw_pt (trans pt_ref 0 1) 1) (draw_pt (trans new_pt 0 1) 3))
         (progn (redraw) (draw_pt (trans pt_ref 0 1) 1))
       )
     )
     (if new_pt
       (progn
         (initget "Oui Non _Yes No")
         (if (not (setq key (getkword "\nGénerer le/les points [Oui/Non]? <O>: "))) (setq key "Yes"))
         (cond
           ((eq key "Yes")
             (entmake
               (list
                 '(0 . "POINT")
                 '(100 . "AcDbEntity")
                 (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
                 (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
                 (cons 8 (getvar "CLAYER"))
                 '(100 . "AcDbPoint")
                 (cons 10 new_pt)
                 '(210 0.0 0.0 1.0)
               )
             )
             (entmake
               (list
                 '(0 . "POINT")
                 '(100 . "AcDbEntity")
                 (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
                 (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
                 (cons 8 (getvar "CLAYER"))
                 '(100 . "AcDbPoint")
                 (cons 10 pt_ref)
                 '(210 0.0 0.0 1.0)
               )
             )
           )
         )
       )
     )
     (redraw)
   )
   (T
     (princ "\nLa longueur introduite est plus grande que l'objet.")
   )
 )
 (redraw ent 4)
 (prin1)
)

 

NB: J'ai simplifié la 1ère version proposée. J'ai supprimé l'option Complémentaire qui n'était pas vraiment utile et donnait une confusion d'utilisation.

Le click-gauche est devenue la bascule pour ajouter/retrancher la longueur spécifiée (si cela est possible, bien sur!)

Modifié le 7 novembre 2012 par bonuscad

[lecrabe]

Hello

 

Waouh c presque parfait, car en fait je desire pouvoir dessiner 2 points graphiques :

- Le 1er au point de "depart" clique sur l'objet (ta routine actuelle ne le fait pas)

en general avec un accrochage du genre : extremite, proche, ...

- Le 2eme point a la distance curviligne specifiee sur l'objet (ta routine actuelle le fait tres bien)

 

Car je desire voir visuellement et efficacement si a partir d'un point sur un objet curviligne,

je peux me deplacer (ou pas) sur une distance de xxx.xx unites graphiques !

 

Mais tu utilises peut etre cette routine pour un autre objectif ?

Lequel SVP (si ce n'est pas indiscret) ?

 

Encore Merci pour le boulot, lecrabe

[lecrabe]

Hello

 

J'ai un micro-bug avec les Splines

 

Lors de mes tests (MAP 2012/2013 32 bits) lorsque que je clique (avec extremite) sur le point final

d'une ligne ou arc ou pline ou pline splinee, la routine "recule bien" pour me montrer et dessiner le point voulu

 

Par contre sur une vraie Spline lorsque je clique sur le point final de la Spline,

la routine revient au point de depart et me montre et dessine le point voulu depuis ce point de depart

et non pas depuis le point final de la Spline !?

 

Vois tu ce que je veux dire ?

 

Merci, lecrabe

[bonuscad]

J'ai un micro-bug avec les Splines

 

J'ai regardé et cela vient de la fonction (vlax-curve-getPointAtDist) qui avec une spline (et seulement ce type d'objet!...) arrive à retourner un point même si l'argument distance est complètement loufoque (distance négative par exemple)

 

J'ai donc introduit des contrôles supplémentaires pour palier à cet inconvénient, ça à l'air de fonctionner mais en contre partie la routine n'a plus le même comportement qu'avant avec des cercles et ellipses complètes: on ne peut plus dépasser l'origine trigo comme avant.

 

PS: Les codes proposés ont été corrigés. Je pense avoir maintenant répondu à ton souhait.

Les Splines sont des entités complexes que je n'aime pas manipuler en programmation car j'avais déjà constaté des retours très surprenant avec les fonctions (vlax-curve-xxxxxxx) qui m'échappe complétement.

[lecrabe]

Hello

 

Reteste sur MAP 2013 32 bits, cela me semble PARFAIT !

Y compris avec ces "foutues" SPLINEs !!

 

Et en effet je suis bien d'accord avec toi, de facon generale j'interdis l'usage des SPLINEs

SURTOUT pour du graphe de reseau !

Les Polylignes Splinees sont tout a fait satisfaisantes ...

 

Par contre en Mecanique ou en dessin "graphique" : les SPLINEs c'est TRES UTILE !

 

Merci pour ton travail et le Partage avec la Communaute, lecrabe