Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Faire une mesure sur un objet curviligne

bonuscad

Par bonuscad
dans Routines LISP

 Partager

Messages recommandés

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e) (modifié)

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é par bonuscad

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

-Olivier- Newbie

-Olivier-

Posté(e)
Posté(e)

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 Collaborator

bonuscad

Posté(e)
  • Auteur
Posté(e)

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.

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

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

Autodesk Expert Elite Team

bonuscad Collaborator

bonuscad

Posté(e)
  • Auteur
Posté(e) (modifié)
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é par bonuscad

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

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

Autodesk Expert Elite Team

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

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

Autodesk Expert Elite Team

bonuscad Collaborator

bonuscad

Posté(e)
  • Auteur
Posté(e)
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.

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

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

Autodesk Expert Elite Team

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité