Coordonnées des points intermédiaires sur une polyligne

[nikjust]

Slt à tous,

Est-il possible de récupérer les coordonnées d'un point situé sur d'une polyligne en VBA à partir d'un distance donnée par l'utilisateur:

1. l'application demande à l'utilisateur de donner une distance X

2.l'application récupère la distance X

3. Et donne les coordonnées du point situé à la distance X de l'origine de la polyligne.

 

Merci bcp pour votre aide, je suis un débutant en VBA et compte sur votre aide

[(gile)]

Salut et bienvenue,

 

Tu demandes du VBA et tu postes dans un forum LISP ?!

 

Je vais te répondre en LISP, car je crois bien que les fonctions équivalentes aux fonction vlax-curve* n'existent pas en VBA.

 

La routine fonctionne avec tout type de polyligne et aussi avec les arcs, cercles, ellipses, lignes et splines.

Le résultat est retourné à la ligne de commande.

 

(defun c:PointAtDist (/ ent dist result)
 (vl-load-com)
 (if
   (and (setq ent (car (entsel)))
        (member (vla-get-ObjectName (setq ent (vlax-ename->vla-object ent)))
                '("AcDbArc"           "AcDbCircle"        "AcDbEllipse"
                  "AcDbLine"          "AcDbPolyline"      "AcDb2dPolyline"
                  "AcDb3dPolyline"    "AcDbSpline"
                 )
        )
   )
    (if (and
          (setq dist (getdist "\nSpécifiez la distance: "))
          (setq result (vlax-curve-getPointAtDist ent dist))
        )
      (princ result)
      (princ "\nDistance non valide")
    )
    (princ "\nEntité non valide")
 )
 (princ)
)

 

 

[lecrabe]

 

Hello Gilles

 

Comme d'hab., ta routine fonctionne super bien !

 

Cependant SVP je sollicite qq ameliorations :

Cela devrait rendre bien des services ...

 

1) Poser la question :

Voulez vous generer un point graphique (O/N) Defaut = N : ?

 

2) Pouvoir selectionner N entites

 

3) Resultat : N possibles/traitables mais M objets traites

(because Parametre de la distance)

 

Merci d'avance, Le Decapode (toujours plein d'idees)

 

[nikjust]

Merci infiniment Gilles,

j'ai appris quelques notions en lisp et jè vérifier et ton code est parfait, think!

 

 

 

 

 

 

 

 

 

Salut et bienvenue,

 

Tu demandes du VBA et tu postes dans un forum LISP ?!

 

Je vais te répondre en LISP, car je crois bien que les fonctions équivalentes aux fonction vlax-curve* n'existent pas en VBA.

 

La routine fonctionne avec tout type de polyligne et aussi avec les arcs, cercles, ellipses, lignes et splines.

Le résultat est retourné à la ligne de commande.

 

(defun c:PointAtDist (/ ent dist result)
 (vl-load-com)
 (if
   (and (setq ent (car (entsel)))
        (member (vla-get-ObjectName (setq ent (vlax-ename->vla-object ent)))
                '("AcDbArc"           "AcDbCircle"        "AcDbEllipse"
                  "AcDbLine"          "AcDbPolyline"      "AcDb2dPolyline"
                  "AcDb3dPolyline"    "AcDbSpline"
                 )
        )
   )
    (if (and
          (setq dist (getdist "\nSpécifiez la distance: "))
          (setq result (vlax-curve-getPointAtDist ent dist))
        )
      (princ result)
      (princ "\nDistance non valide")
    )
    (princ "\nEntité non valide")
 )
 (princ)
)

 

 

 

 

[lecrabe]

 

Hello Gilles

 

Un petit UP pour redemander SVP une petite amelioration (voir mon 1er message) ...

 

Merci d'avance, Decapodiquement Votre

 

[nikjust]

Hello Gilles,

Je suis de retour pour demander ton aide : Je constate que ton programme retourne le résultat en ligne de commande est-ce que c'est possible de l'envoyer directement dans une fonction VBA? Merci

 

 

 

 

Salut et bienvenue,

 

Tu demandes du VBA et tu postes dans un forum LISP ?!

 

Je vais te répondre en LISP, car je crois bien que les fonctions équivalentes aux fonction vlax-curve* n'existent pas en VBA.

 

La routine fonctionne avec tout type de polyligne et aussi avec les arcs, cercles, ellipses, lignes et splines.

Le résultat est retourné à la ligne de commande.

 

(defun c:PointAtDist (/ ent dist result)
 (vl-load-com)
 (if
   (and (setq ent (car (entsel)))
        (member (vla-get-ObjectName (setq ent (vlax-ename->vla-object ent)))
                '("AcDbArc"           "AcDbCircle"        "AcDbEllipse"
                  "AcDbLine"          "AcDbPolyline"      "AcDb2dPolyline"
                  "AcDb3dPolyline"    "AcDbSpline"
                 )
        )
   )
    (if (and
          (setq dist (getdist "\nSpécifiez la distance: "))
          (setq result (vlax-curve-getPointAtDist ent dist))
        )
      (princ result)
      (princ "\nDistance non valide")
    )
    (princ "\nEntité non valide")
 )
 (princ)
)

 

[(gile)]

Salut,

 

Je suis un peu "overbooké" ces jours ci, je n'avais pas vu passer les messages.

 

 

lecrabe,

Une version avec jeu de sélection et possibilité de dessiner un point graphique.

 

(defun c:PointAtDist (/ ss dist result point cnt1 cnt2)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq cnt1 0
       cnt2 0
 )
 (if (setq ss (ssget (list '(-4 . "                            '(-4 . "                            '(70 . 112) '(-4 . "NOT>") '(-4 . "AND>") '(-4 . "OR>"))
              )
     )
   (progn
     (initget 1)
     (setq dist (getdist "\nSpécifiez la distance: "))
     (initget "Oui Non")
     (if (/= "Non"
             (setq point
                    (getkword "\nVoulez vous un point graphique ? [Oui/Non] : "
                    )
             )
         )
       (setq point "Oui")
     )
     (setq space (vla-get-ModelSpace *acdoc*))
     (vla-StartUndoMark *acdoc*)
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
       (setq cnt1 (1+ cnt1))
       (if (setq result (vlax-curve-getPointAtDist obj dist))
         (progn
           (setq cnt2 (1+ cnt2))
           (if point
             (vla-AddPoint space (vlax-3d-point result))
           )
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ (strcat "\n"
                (itoa cnt1)
                " objet(s) sélectionné(s) -> "
                (itoa cnt2)
                " traité(s)"
        )
 )
 (princ)
)

 

nikjust,

 

Je ne sais pas s'il est possible de passer des données directement d'une routine LISP à une macro VBA (en tous cas, je ne sais pas le faire, je ne cause pas VBA)

Je crois savoir qu'un moyen souvent employé pour ce faire est d'utiliser les variables système USER*.

Je te propose donc une solution qui attribue à USERR1 la coordonnée X du point, à USERR2 la coordonnée Y, et à USERR3 le Z.

 

(defun c:PointAtDist (/ ent dist result)
 (vl-load-com)
 (if
   (and (setq ent (car (entsel)))
        (member (vla-get-ObjectName (setq ent (vlax-ename->vla-object ent)))
                '("AcDbArc"           "AcDbCircle"        "AcDbEllipse"
                  "AcDbLine"          "AcDbPolyline"      "AcDb2dPolyline"
                  "AcDb3dPolyline"    "AcDbSpline"
                 )
        )
   )
    (if (and
          (setq dist (getdist "\nSpécifiez la distance: "))
          (setq result (vlax-curve-getPointAtDist ent dist))
        )
      (progn
        (setvar "USERR1" (car result))
        (setvar "USERR2" (cadr result))
        (setvar "USERR3" (caddr result))
        (princ result)
      )
      (princ "\nDistance non valide")
    )
    (princ "\nEntité non valide")
 )
 (princ)
)

[thry0]

Bjr à tous,

 

A priori pour un arc, le point se dessine à une distance par rapport

à l'extrémité de fin alors que pour une ligne, par exemple,

elle est considérée par rapport à l'extrémité de départ. Est ce normal ?

[(gile)]

Salut

 

Pas chez moi en tous cas...

[thry0]

Re,

 

Je confirme ... la routine semble considérer les arcs

dans le sens trigonométrique pour le placement du point, sens anti horaire donc,

mais n'étant pas le demandeur ... c'était juste une remarque en passant

[(gile)]

Salut,

 

Au temps pour moi, je n'avais pas bien lu "arc" mais extrapolé "arc de polyligne".

 

Avec les arcs de cercles, le point de départ (comme l'angle de départ) est toujours considéré en sens trigonométrique, même pour un arc "3 points" dont on aurait spécifié les points en sens horaire (regarde les propriétés d'un tel arc).

[lecrabe]

 

Hello

 

Comme d'habitude (pour mon avis) les routines de Gilles fonctionnent bien :)

 

Encore Merci, Le Decapode

 

[lecrabe]

 

Hello

 

Une version legerement amelioree de POINTATDIST1 par GC

 

Encore Merci Gilles, Le Decapode

 

 


;;
;; Demande : Recuperer les coordonnees d'un point situe
;; sur une polyligne par rapport au point de depart
;;
;; Routine VLisp par GC le 31/08/2009 version 1.20
;; avec le perimetre/longueur de l'objet
;;
;; La routine fonctionne avec tout type de polyligne
;; et aussi avec les arcs, cercles, ellipses, lignes et splines.
;;
;; Le resultat est retourne sur la ligne de commande.
;;
;; Commande au clavier :  POINTATDIST1
;;

(defun c:PointAtDist1 (/ ent obj picked dist1 dist2 result)
 (vl-load-com)
 (if
   (and (setq ent (entsel))
        (member (vla-get-ObjectName (setq obj (vlax-ename->vla-object (car 

ent))))
                '("AcDbArc"           "AcDbCircle"        "AcDbEllipse"
                  "AcDbLine"          "AcDbPolyline"      "AcDb2dPolyline"
                  "AcDb3dPolyline"    "AcDbSpline"
                 )
        )
   )
    (if (and
          (setq dist1 (getdist "\nSpecifiez la distance : "))
          (setq result (vlax-curve-getPointAtDist obj dist1))
        )
      (progn
        (setq picked (if (= (vla-get-ObjectName obj) "AcDb2dPolyline")
                       (vlax-curve-getClosestPointToProjection
                         obj
                         (trans (cadr ent) 1 0)
                         (mapcar '-
                                 (trans (getvar "VIEWDIR") 1 0)
                                 (trans '(0 0 0) 1 0)
                         )
                       )
                       (trans (osnap (cadr ent) "_nea") 1 0)
                     )
              dist2 (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
        )
        (princ (strcat "\nPoint à " (rtos dist1) " : "))
        (princ result)
        (princ "\nPoint cliqué : ")
        (princ picked)
        (princ
          (strcat
            " à "
            (rtos (setq dist3 (vlax-curve-getDistAtPoint obj picked))
            )
            " du départ et "
            (rtos (- dist2 dist3))
            " de la fin\nPérimètre de l'objet : "
            (rtos dist2)
          )
        )
        (textscr)
      )
      (princ "\nDistance non valide")
    )
    (princ "\nEntite non valide")
 )
 (princ)
)

 

 

 

[pierrevigneux]

Helo le Crabe !

J'ai essayé ta routinre POINTATDIST1 et j'aimerais si possible, une petite modification ou addition soit en plus de retourner la distance sur la ligne de commande pouvoir y insérerun texte choisi par l'utlisateur ex: C.C. commencement de courbe P.K. point kilométrique 0+0105,50 avec sa coordonnée

 

La commande pourrais en plus de récupérer les coordonnées des débuts te fin de segments les côter

depuis le début de la polyligneé

 

Merci !

 

[Edité le 23/1/2010 par pierrevigneux]