Point le plus proche d\'une polyligne

[loloz78]

Bonjour,

Je débute en Lisp est ce forum est vraiment très constructif pour moi.

Voilà mon problème, je n'ai pas réussi à voir sur le forum un lisp qui y ressemble.

J'ai une polyligne ( je sais si le dessin en dessous sera bien visible) et je dois avoir la coordonnée de ce point qui perpendiculairement le plus proche de la polyligne existante (pas une droite prolongée).

 

..........................___

......................../......|

___________/........|

................................|

.......................o.......|

________________|

........................[surligneur] Ici[/surligneur] la perpendiculaire sera sur cette droite horizontale dans cette exemple

 

 

 

 

Une autre qui est d'enregistrer la coordonnée de l'intersection intérieur des 2 points avec la polyligne.

..........................___

......................../......|

___________/........|

................................|

.......................o.......|

________________|

........................o.......

 

PS : quelqu'un pourrait m'expliquer la fonction "mapcar" et "lambda" avec un exemple concret car j'ai rien compris même en déchiffrant des lisp.

 

Merci.

 

 

[Bred]

Salut,

Esc-ce que ce lisp ne répondrais pas à ce que tu demandes ?

 

[loloz78]

Presque, en fait, le tien est plus complexe que ma demande (enfin je crois) (j'ai vraiment rien compri à ton lisp :) mais je vais essayé), en pratique il prend, à partir d'un point, et le prolonge que sur la polyligne (ça c'est super) en ortho (j'ai besoin qu'il le retourne sur la polyligne en perpendiculaire la plus proche) et apparament que en SCU général (si c'était possible dans n'importe quel SCU?).

 

Je n'arrive pas à déchiffré ton lisp sinon j'aurais essayer de l'appliquer à mon problème seulement je n'ai pas encore compris les commandes "vl-...", j'ai besoin d'un peu plus d'aide STP.

 

Merci.

 

[(gile)]

Salut et bienvenue,

 

Pour mapcar et lambda j'avais essaté un début d'explication dans ce sujet (réponses 8 et 15)

 

Pour les routines, l'utilisation des fonction vlax-curve... simplifiera notablement le code.

[(gile)]

Voilà deux petites routines.

Comme je disais ci dessus, les foctions Visual LISP sont beaucoup plus commodes pour faire ce que tu veux.

J'ai donc tout écrit en Visual LISP, mais si tu préfères utiliser entmake pour créer les lignes, on peut le changer.

 

J'ai essayer de commenter abondamment, ces LISP assez simples peuvent être de bons exemples pour débuter en Visual LISP.

 

(defun c:perp (/ sp pl pt pp ang)

 ;; chargement des fonction Visual LISP
 (vl-load-com)

 ;; pointeur vers le document actif (variable globale)
 (or *acdoc*
     (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object)))
 )

 ;; pointeur vers l'espace actif
 (setq	sp (if (= (getvar "CVPORT") 1)
     (vla-get-PaperSpace *acdoc*)
     (vla-get-ModelSpace *acdoc*)
   )
 )

 ;; sélection de la polyligne
 (while (not
   (setq pl (car (entsel "\nSélectionnez la polyligne: ")))
 )
 )

 ;; tant qu'on spécifie un point...
 (while (setq pt (getpoint "\nSpécifiez un point :"))

   ;; conversion danq le SCG
   (setq pt (trans pt 1 0))

   ;; point le plus proche sur la polyligne
   (setq pp  (vlax-curve-getClosestPointTo pl pt))

   ;; angle de la polyligne au point + 90°
   (setq ang (+ (angle	'(0 0 0)
		(vlax-curve-getFirstDeriv
		  pl
		  (vlax-curve-getParamAtPoint pl pp)
		)
	 )
	 (/ pi 2)
      )
   )

   ;; si l'angle est égal à celui des deux points (à 180° près)...
   (if	(equal (rem (angle pt pp) pi) (rem ang pi) 1e-9)

     ;; ...création de la ligne
     (vla-addLine
sp
(vlax-3d-point pt)
(vlax-3d-point pp)
     )

     ;; sinon message
     (princ
"\nPas de perpendiculaire à la polyligne depuis ce point."
     )
   )
 )
 (princ)
) 

 

(defun c:int-pl (/ pl p1 p2)
 ;; chargement des fonction Visual LISP
 (vl-load-com)

 ;; pointeur vers le document actif (variable globale)
 (or *acdoc*
     (setq *acdoc* (vla-get-activeDocument (vlax-get-acad-object)))
 )

 ;; pointeur vers l'espace actif
 (setq	sp (if (= (getvar "CVPORT") 1)
     (vla-get-PaperSpace *acdoc*)
     (vla-get-ModelSpace *acdoc*)
   )
 )

 ;; Entrées utilisateur
 (while (not
   (setq pl (car (entsel "\nSélectionnez la polyligne: ")))
 )
 )
 (while (not (setq p1 (getpoint "\nSpécifiez le premier point :")))
 )
 (while (not (setq p2 (getpoint "\nSpécifiez le deuxième point :")))
 )

 ;; création d'une ligne entre les deux points
 (setq	li
 (vla-addLine
   sp
   (vlax-3d-point (trans p1 1 0))
   (vlax-3d-point (trans p2 1 0))
 )
 )

 ;; si intersection entre la ligne et la polyligne...
 (if (setq int	(vlax-invoke
	  (vlax-ename->vla-object pl)
	  'IntersectWith
	  li
	  acExtendNone
	)
     )

   ;; ...message résultat
   (princ (strcat "\nIntersection au point: "
	   (rtos (car int) 2 2)
	   ","
	   (rtos (cadr int) 2 2)
	   ","
	   (rtos (caddr int) 2 2)
	   ","
   )
   )
   ;; sinon
   (princ "\nAucune intersection.")
 )

 ;; suppression de la ligne
 (vla-delete li)
 
 (princ)
) 

 

[Edité le 8/12/2007 par (gile)]

[bonuscad]

Ma version de perpendiculaire, similaire à (gile), utilise vlax-curve-get

 

(defun c:perp2obj (/ js pt en dxf_11)
(vl-load-com)
(princ "\nSélectionnez un objet curviligne.")
(while (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE") (-4 . "[b]<[/b]NOT") (0 . "MLINE") (-4 . "NOT>"))))
	(while (setq pt (getpoint "\nDonnez un point pour tracer la perpendiculaire à l'objet: "))
		(setq dxf_11 (vlax-curve-getClosestPointTo (setq en (ssname js 0)) (trans pt 1 0)))
		(cond
			((and
				(not (equal dxf_11 (vlax-curve-getStartPoint en) 1e-9))
				(not (equal dxf_11 (vlax-curve-getEndPoint en) 1e-9))
			 )
				(entmake
					(list
						(cons 0 "LINE")
						(cons 10 (trans pt 1 0))
						(cons 11 dxf_11)
					)
				)
			)
			(T (princ "\nPas de perpendiculaire en ce point"))
		)
	)
)
(prin1)
)

[lili2006]

Bonjour à toutes et tous,

 

(gile), le Lisp "INT-PL" "arrondi" le résultat ?? ! Exemple ci-dessous =>

 

 

INT-PL

Sélectionnez la polyligne:

Spécifiez le premier point :

Spécifiez le deuxième point :

Intersection au point: ( 71383.3 105868.0 0.0)

Commande:

Commande: '_id Spécifiez un point: X = 71383.27 Y = 105867.72 Z = 0.00

 

Que dois-je changer dans ma configuration pour avoir la précision centimètrique ?

 

Merci d'avance.

[(gile)]

Salut,

 

J'ai changé la forme du message retourné, j'avais écrit, pour aller au plus court :

 

(princ (strcat "\nIntersection au point: "
	   (vl-princ-to-string int)
   )
   ) 

 

vl-princ-to-string permet de transformer directement la liste en chaîne, mais pour des raisons d'affichage le nombre de décimales affichées varie suivant la longueur du nombre :

 

Je l'ai donc remplacé par l'exression suivante, où il est possible de changer le nombre de décimales affichées :

 

(rtos (car int) 2 2) = 2 décimales

(rtos (car int) 2 4) = 4 décimales

(rtos (car int) 2 0) = aucune décimale

 

(princ (strcat "\nIntersection au point: "
	   (rtos (car int) 2 2)
	   ","
	   (rtos (cadr int) 2 2)
	   ","
	   (rtos (caddr int) 2 2)
	   ","
   )
   ) 

[lili2006]

Re,

 

Nickel (gile).

 

Merci ! Trés pratique ce genre d'outil en topographie,...

 

Bon WE.

[loloz78]

Franchement genial, c'est pile ce qui me fallait merci (gile).

Merci aussi BonusCad, car ton lisp m'a permis de faire une autre fonction que j'étaits entrain de faire mais largement plus simple avec du texte (voir ci-dessous) essayer le si il marche, prob entre AutoCad 2004 et 2007 c'est la création de texte (maintenat je sais comment faire avec entmake merci à vous). Vous allez voir c'est du débutant <acronym class=dict title= :). Mais je trouve ça pas mal juste en lisp et pas de vlisp (j'aprend vlisp j'aprend). Seulement je n'arrive pas, avec ton lisp, à tourner le texte pour qu'il soit aligner en scu temporaire et non en général(fonction vlisp??). Merci.

 

(defun C:aze (/)

(setq oldtypect1 (getvar "cecolor") oldtypect2 (getvar "textstyle") oldtypect3 (getvar "clayer") oldtypect4 (getvar "celweight") oldtypesnap (getvar "snapmode"))

(setvar "cecolor" "blanc")

(setvar "textstyle" "standard")

(setvar "clayer" "0")

(setvar "celweight" 30)

(setvar "snapmode" 0)

(setq oldtypeosmode (getvar "osmode"))

 

(setq sep1 (getpoint "\nSpécifiez le centre du SE: "))

(setq ray 20)

(command "_.circle" "_none" sep1 ray)

(command "_.text" "J" "MC" "_none" sep1 "_none" 20 "_none" 0 "AB")

(princ)

 

(repeat (1- 1000)

(setvar "osmode" 8)

(setq sep2 (getpoint "\nSelectionner les points SE"))

(setq sedd (list (+ (car sep1) ray) (cadr sep1) (caddr sep1)))

(setq seds (list (+ (- (distance sep1 sep2) ray) (car sedd)) (cadr sep1) (caddr sep1)))

(command "_.line" "_none" sedd "_none" seds "")

(setq seang (* 180 (/ (angle sep1 sep2) pi)))

(command "_.rotate" "_none" "d" "" "_none" sep1 seang)

(setvar "cecolor" oldtypect1)

(setvar "textstyle" oldtypect2)

(setvar "clayer" oldtypect3)

(setvar "celweight" oldtypect4)

(setvar "snapmode" oldtypesnap)

(setvar "osmode" oldtypeosmode)

))

 

[Edité le 10/12/2007 par loloz78]