Points proche de

Virgile_69 · le 25 août 2004

Bonjour,

J'utilise la fonction entsel sur une polyligne qui me donne le nom d'entité el le point cliqué puis je ressort tous les sommets de la polyligne.

Ce que je voudrais faire c'est ressortir les deux points les plus proche de mon point cliqué.

Merci d'avance

le 25 août 2004

Utilises la fonction Vlisp (vlax-curve-getClosestPointTo)

Serge · le 25 août 2004

Je pense que Virgule_69 veut les 2 sommets le plus près et non le point correspondant à la perpendiculaire.

Ceci montre les 2 sommets le plus près ainsi que le plus éloigné. 3 cercles tépoins sont dessinnés.

(defun c:FindClosestPoints (

/ cecolor cordes i liste n objSel pline plineGet pt sommet sommets

)

(cond

((not (setq objSel (entsel "\nMontrez la polyligne optimisée: ")))

(princ "\nAucun objet sélectionné.")

)

((/= "LWPOLYLINE" (cdr (assoc 0 (setq plineGet (entget (setq pline (car objSel)))))))

(princ "\nPas une polylignes optimisée.")

)

((not (setq pt (getpoint "\nMontrez un point: ")))

(princ "\nPas de point détecté.")

)

(t

(setq sommets (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) plineGet)))

(setq i 0 n (length sommets))

(setq cordes nil)

(while (< i n)

(setq sommet (nth i sommets))

(setq liste (list i (distance pt sommet) sommet))

(setq cordes (cons liste cordes))

(setq i (1+ i))

)

(setq cordes (vl-sort cordes (function (lambda (dist1 dist2) (< (cadr dist1) (cadr dist2))))))

;; Cercles témoins, rayon = 2% de l'écran

(setq cecolor (getvar "cecolor"))

(setvar "cecolor" "1")

(command "._circle" "_none" (caddr (nth 0 cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" "2")

(command "._circle" "_none" (caddr (nth 1 cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" "3")

(command "._circle" "_none" (caddr (last cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" cecolor)

;; Sommet le plus près [iD, distance]: coordonnée

(princ (strcat "\nSommet le plus près ["

(itoa (car (nth 0 cordes))) ", dist = " (rtos (cadr (nth 0 cordes))) "]: ")

)

(princ (caddr (nth 0 cordes)))

;; Sommet suivant le plus près [iD, distance]: coordonnée

(princ (strcat "\nSommet suivant le plus près ["

(itoa (car (nth 1 cordes))) ", dist = " (rtos (cadr (nth 1 cordes))) "]: ")

)

(princ (caddr (nth 1 cordes)))

;; Sommet le plus loin [iD, distance]: coordonnée

(princ (strcat "\nSommet suivant le plus près ["

(itoa (car (last cordes))) ", dist = " (rtos (cadr (last cordes))) "]: ")

)

(princ (caddr (last cordes)))

)

(princ)

)

Serge

le 25 août 2004

Effectivement, j'avais lu un peu vite la question.. désolé :red:

Virgile_69 · le 25 août 2004

Re-bonjour

La routine à Serge est juste ce que je voulais faire

Merci

bonuscad · le 26 août 2004

Salut Serge,

C'est une fonction que je voulais réaliser depuis longtemps. :P

Cependant il existe encore un Hic dans ta fonction, elle fonctionne bien en cas de polyligne "tendue", par contre si un sommet vient à se rapprocher au segment sélectionné (une polyligne en "serpentin"), les sommets retournés ne sont plus ceux qu'on attend.

Je pense que je vais creuser dans la direction de comparaison de distance de parcours plutôt que de comparaison de distance à sommets, si j'y arrive ! ;) va falloir que je me mette aux fonction (vlax-curve....)

Serge · le 26 août 2004

Patrick,

Dans ce programme, une amélioration pour trouver les sommets qui généralise les cas. Je me souviens que tu avais un fil là dessus.

Bruno,

Voici donc une routine modifiée qui tient compte des plines éditée en "Fit curve" et "spline".

(defun c:FindClosestPoints (

/ cecolor cordes i liste n objSel pline plineGet pt sommet sommets

)

(cond

((not (setq objSel (entsel "\nMontrez la polyligne optimisée: ")))

(princ "\nAucun objet sélectionné.")

)

((not (wcmatch (cdr (assoc 0 (setq plineGet (entget (setq pline (car objSel)))))) "*POLYLINE"))

(princ "\nPas une polyligne.")

)

((not (setq pt (getpoint "\nMontrez un point: ")))

(princ "\nPas de point détecté.")

)

(t

(setq sommets (getVertices pline))

(setq i 0 n (length sommets))

(setq cordes nil)

(while (< i n)

(setq sommet (nth i sommets))

(setq liste (list i (distance pt sommet) sommet))

(setq cordes (cons liste cordes))

(setq i (1+ i))

)

(setq cordes (vl-sort cordes (function (lambda (dist1 dist2) (< (cadr dist1) (cadr dist2))))))

;; Cercles témoins, rayon = 2% de l'écran

(setq cecolor (getvar "cecolor"))

(setvar "cecolor" "1")

(command "._circle" "_none" (caddr (nth 0 cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" "2")

(command "._circle" "_none" (caddr (nth 1 cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" "3")

(command "._circle" "_none" (caddr (last cordes)) (* 0.02 (getvar "viewsize")))

(setvar "cecolor" "4")

(command "._circle" "_none" pt (* 0.02 (getvar "viewsize")))

(setvar "cecolor" cecolor)

;; Point choisi (cyan) : coordonnée

(princ "\nPoint choisi (cyan) : ") (princ pt)

;; Sommet le plus près (rouge) [iD, distance]: coordonnée

(princ (strcat "\nSommet le plus près (rouge) ["

(itoa (car (nth 0 cordes))) ", dist = " (rtos (cadr (nth 0 cordes))) "]: ")

)

(princ (caddr (nth 0 cordes)))

;; Sommet suivant le plus près (jaune) [iD, distance]: coordonnée

(princ (strcat "\nSommet suivant le plus près (jaune) ["

(itoa (car (nth 1 cordes))) ", dist = " (rtos (cadr (nth 1 cordes))) "]: ")

)

(princ (caddr (nth 1 cordes)))

;; Sommet le plus loin (vert) [iD, distance]: coordonnée

(princ (strcat "\nSommet le plus loin (vert) ["

(itoa (car (last cordes))) ", dist = " (rtos (cadr (last cordes))) "]: ")

)

(princ (caddr (last cordes)))

)

(princ)

)

(defun getVertices (

ename

/ plineGet return vertex vertexGet

)

(setq return nil)

(cond

((or (/= (type ename) 'ENAME) (not (setq plineGet (entget ename)))) (setq return nil))

((= "POLYLINE" (cdr (assoc 0 plineGet)))

(setq vertex (entnext ename))

(while (= "VERTEX" (cdr (assoc 0 (setq vertexGet (entget vertex)))))

(setq return (cons (cdr (assoc 10 vertexGet)) return))

(setq vertex (entnext vertex))

)

(setq return (reverse return))

)

((= "LWPOLYLINE" (cdr (assoc 0 plineGet)))

(setq return (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) plineGet)))

)

(t (setq return nil))

)

return

)

(princ "\nTapez FindClosestPoints pour trouver les sommets les plus près")

(princ)

Serge

bonuscad · le 27 août 2004

Salut Serge,

Je crois que tu n'a pas compris ma remarque.

Ce que je voulais dire, le mieux c'est un exemple.

Fais un rectangle, applique ta routine en donnant par exemple le milieu du segment bas horizontal. Les points retournés sont effectivement le précédent et suivant.

Edite ce rectangle pour y inserer un sommet dans le segment haut horizontal, ce sommet tu le place près du milieu du segment bas, tu obtiens une figure CONCAVE

Si tu applique ta routine a cette nouvelle polyligne les sommets retournés ne sont pas le précédent et suivant.

Normal car le test ce fait sur des distances droite et non curvilignes.

Serge · le 27 août 2004

Salut Bruno,

Veux-tu simplement obtenir entre quels 2 sommets ton point choisi se situe, en prenant le chemin le plus court entre ce point et l'objet?

Serge

bonuscad · le 30 août 2004

Serge,

J'ai réussir à faire ce que je voulais ;)

Cette routine retourne les points, dans le scu courant, les plus proches sur le parcours du polyligne 2D ou 3D. Celle ci peut être lissée, pas splinée et les mailles sont refusées.

(defun draw_pt (pt / pt1 pt2 pt3 pt4)
(setq
	rap (/ (getvar "viewsize") 50)
	pt1 (list (+ (car pt) rap) (+ (cadr pt) rap))
	pt2 (list (+ (car pt) rap) (- (cadr pt) rap))
	pt3 (list (- (car pt) rap) (- (cadr pt) rap))
	pt4 (list (- (car pt) rap) (+ (cadr pt) rap))
)
(grdraw pt pt1 -1)
(grdraw pt pt2 -1)
(grdraw pt pt3 -1)
(grdraw pt pt4 -1)
)
(defun c:near_vertex ( / obj dxf_obj obj_vlax pt_sel pt_dist param_start param_end perim_obj e_next l_som l_dist n n_first n_second result_vertex)
(while (not (setq obj (entsel "\nChoix d'une polyligne "))))
(cond
	((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE")
		(and
			(eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
			(zerop (boole 1 116 (cdr (assoc 70 dxf_obj))))
		)
	)
		(vl-load-com)
		(setq
			obj_vlax (vlax-ename->vla-object (car obj))
			pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans (osnap (cadr obj) "_near") 1 0))
			pt_dist (vlax-curve-getDistAtPoint obj_vlax pt_sel)
			param_start (vlax-curve-getStartParam obj_vlax)
			param_end (vlax-curve-getEndParam obj_vlax)
			perim_obj (vlax-curve-getDistAtParam obj_vlax (+ param_start param_end))
		)
		(cond
			((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
				(setq l_som (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_obj)))
			)
			(T
				(setq e_next (entnext (car obj)))
				(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
					(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
						(setq l_som (cons (cdr (assoc 10 dxf_next)) l_som))
					)
					(setq e_next (entnext e_next))
				)
				(setq l_som (reverse l_som))
			)
		)
		(setq l_dist (mapcar '(lambda (x) (vlax-curve-getDistAtPoint obj_vlax x)) l_som))
		(if (vlax-curve-isClosed obj_vlax)
			(progn
				(setq l_som (append l_som (list (car l_som))))
				(setq l_dist (append l_dist (list perim_obj)))
			)
		)
		(setq n 0)
		(repeat (1- (length l_dist))
			(if (and (> pt_dist (nth n l_dist)) (< pt_dist (nth (1+ n) l_dist)))
				(setq n_first n n_second (1+ n))
			)
			(setq n (1+ n))
		)
		(setq result_vertex (list (trans (nth n_first l_som) 0 1) (trans (nth n_second l_som) 0 1)))
		(redraw)
		(draw_pt (car result_vertex)) (draw_pt (cadr result_vertex))
		(princ result_vertex)
	)
	(T
		(princ "\nN'est pas une polyligne valable pour cette fonction!")
	)
)
(princ)
)

bonuscad · le 8 février 2006

Je reviens sur cette fonction (qui me sert énormément).

Je l'avais testé sous 2002 et 2005 sans surprise.

Je viens d'avoir l'occasion de la testée sur une 2000 (pas 2000i) et là chose étrange, elle fonctionne avec un sommet +1 de décalage, donc sur le dernier ça plante en erreur lisp.

Je n'ais pas compris ce comportement, je soupconne peut être les fonctions (vlax-....) qui auraient un comportement différent sur une 2000.?! :casstet:

Quelqu'un aurait une idée? mon code est-il mal monté?

NB: suite à une autre discussion, j'ai déjà essayé de changer:

perim_obj (vlax-curve-getDistAtParam obj_vlax (+ param_start param_end))

en

perim_obj (vlax-curve-getDistAtParam obj_vlax param_end)

cela ne change rien a ce problème propre à une 2000.

Bon vous direz! Quoi encore une 2000? Je sais, je sais... est ce que ça vaut le coup de résoudre le problème

bonuscad · le 7 mars 2006

Je me réponds à moi même :P

J'ai refondu mon code, et il semble fonctionner correctement (même sous une 2000)

En plus, il est plus condensé qu'avant, bref, tout bénef...

Rappel: Ce code peut servir à recupérer les points des sommets les plus proches du point de sélection d'une polyligne, donc à identifier les extrémités du segment sélectionné.

Les applications sont multiples, on peut, par exemple, récupérer ainsi l'angle du segment pour aligner un texte, reconstruire une ligne par dessus le segment pour ensuite le décaler etc... ceci en intégrant cette routine à vos besoins. Vous pouvez la transformer en sous fonction pour vos besoin (defun near_vertex ....)

(defun draw_pt (pt / pt1 pt2 pt3 pt4)
(setq
	rap (/ (getvar "viewsize") 50)
	pt1 (list (+ (car pt) rap) (+ (cadr pt) rap))
	pt2 (list (+ (car pt) rap) (- (cadr pt) rap))
	pt3 (list (- (car pt) rap) (- (cadr pt) rap))
	pt4 (list (- (car pt) rap) (+ (cadr pt) rap))
)
(grdraw pt pt1 -1)
(grdraw pt pt2 -1)
(grdraw pt pt3 -1)
(grdraw pt pt4 -1)
)
(defun c:near_vertex ( / obj dxf_obj obj_vlax pt_sel par pt_first pt_snd)
(while (not (setq obj (entsel "\nSélectionnez le segment de polyligne à utiliser: "))))
(cond
	((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE")
		(and
			(eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
			(zerop (boole 1 116 (cdr (assoc 70 dxf_obj))))
		)
	)
		(vl-load-com)
		(setq
			obj_vlax (vlax-ename->vla-object (car obj))
			pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans (osnap (cadr obj) "_near") 1 0))
			par (vlax-curve-getParamAtPoint obj_vlax (vlax-curve-getClosestPointTo obj_vlax pt_sel))
			pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
			pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 0 1)
		)
		(redraw)
		(draw_pt pt_first) (draw_pt pt_snd)
		(princ (list pt_first pt_snd))
	)
	(T
		(princ "\nN'est pas une polyligne valable pour cette fonction!")
	)
)
(princ)
)

[Edité le 7/3/2006 par bonuscad]

(gile) · le 7 mars 2006

Encore un coup, Bonuscad a été EXCELLENT !!! :D

Adoptée comme sous-fonction, pour le même résultat, je bidouillais lamentablement avec des test de linéarité entre le point acquis par (osnap (cadr (entsel )) "_near") et les sommets de la polyligne.

Tramber · le 7 mars 2006

Pu...rée.

Je n'avais jamais capté que PARAM était en rapport avec le nombre de segment.

Je me suis toujours demandé comment il était généré....l'imbécile (moi).

Je réussi à faire bugger en répondant EXT et en cliquant le dernier point.

Na na nère.

(gile) · le 7 mars 2006

En plus, il est plus condensé qu'avant

Il me semble qu'il est possible de condenser encore un tout petit peu. Tu fais deux (vlax-curve-getClosestPointTo ... et un (osnap (cadr obj) "_near").

J'ai essayé :

(setq pt_sel (vlax-curve-getClosestPointTo
       obj_vlax
       (trans (cadr obj) 1 0)
     )
     par    (vlax-curve-getParamAtPoint
       obj_vlax
       pt_sel
     )
)

Çà semble suffire.

Encore bravo !

bonuscad · le 7 mars 2006

(gile) Merci pour tes tests ;)

Je suis d'accord pour le doublon (vlax-curve-getClosestPointTo

Pour le (osnap "_near") je l'ai rajouté après coup pour avoir un résultat correct pour la sélection d'une polyligne constituée dans un scu non parrallèle au scg, sans ça, le résultat était incorrect.

Tramber

Effectivement ça peu planter avec une séléction avec une accroche forcé à l'extémité (faut être vicieux) ;) sur le dernier segment seulement.

Je te rassure j'ai découvert param grâce à ElpanovEvgeniy (un Moscovite) avec son lisp lw_width.lsp dont je me suis fortement inspiré. Merci à lui

bonuscad · le 22 avril 2006

Ayant rencontré des problèmes a l'utilisation avec ma fonction. Elle "plantait" lorsqu'on sélectionnait un segment d'arc créé dans un SCU non parrallèle au SCG. J'ai décelé que le problème était du a l'utilisation de (osnap (cadr (entsel)) "_near"), ce point ainsi obtenu et sousmi aux fonctions (vlax-curve n'était pas valide.

Voici comment j'ai pu contourner ce problème pour qu'elle fonctionne de façon plus fiable.

Routine principale pouvant servir de sous-routine pour toute autre fonction

Elle retourne les cordonnées du point précédent et suivant et son paramètre de coubure d'un segment (vertex) de LWPOLYLINE ou POLYLINE2D-3D (non splinée)

(defun draw_pt (pt / rap)
(setq rap (/ (getvar "viewsize") 50))
(foreach n 
	(mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap)))
		'((+ +) (+ -) (- +) (- -))
	)
	(grdraw pt n -1)
)
)
(defun c:near_vertex  ( / old_osmd pt_sel obj dxf_obj obj_vlax par pt_first pt_snd i bulge e_next)
(setq old_osmd (getvar "osmode"))
(setvar "osmode" 2)
(initget 9)
(setq pt_sel (getpoint "\nSélectionnez le segment de polyligne à utiliser: "))
(while (null (setq obj (nentselp pt_sel)))
	(initget 9)
	(setq pt_sel (getpoint "\nSélectionnez le segment de polyligne à utiliser: "))
)
(setvar "osmode" 0)
(setq dxf_obj (entget (car obj)))
(if (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "VERTEX")
	(setq dxf_obj (entget (cdr (assoc 330 dxf_obj))))
)
(cond
	((or (eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
		(and
			(eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
			(zerop (boole 1 116 (cdr (assoc 70 dxf_obj))))
		)
	 )
		(vl-load-com)
		(setq
			obj_vlax (vlax-ename->vla-object (cdar dxf_obj))
			pt_sel (vlax-curve-getClosestPointTo obj_vlax (trans pt_sel 1 0))
			par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
			pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
			pt_snd (vlax-curve-getPointAtParam obj_vlax (1+ (fix par)))
			i 0
		)
		(if (null pt_snd)
			(setq pt_snd (trans (vlax-curve-getEndPoint obj_vlax) 0 1))
			(setq pt_snd (trans pt_snd 0 1))
		)
		(cond
			((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE")
				(while (or (/= (caar dxf_obj) 42) (if (< i (fix par)) (setq i (1+ i))))
					(setq bulge (cdadr dxf_obj) dxf_obj (cdr dxf_obj))
				)
			)
			(T
				(setq e_next (entnext (cdar dxf_obj)))
				(repeat (fix par) (setq e_next (entnext e_next)))
				(setq bulge (cdr (assoc 42 (entget e_next))))
			)
		)
		(redraw)
		(draw_pt pt_first) (draw_pt pt_snd)
		(princ (list pt_first pt_snd bulge))
	)
	(T
		(princ "\nN'est pas une polyligne valable pour cette fonction!")
	)
)
(setvar "osmode" old_osmd)
(princ)
)

Voici une autre routine montrant l'emploi qui peut être fait de cette fonction utilisée en fonction secondaire. Ici un exemple pour interroger le rayon de tout morceau d'arc ou cercle depuis n'importe quel SCU depuis n'importe quel SCO:

(defun near_vertex_arr (dxf_ent pt_sel / obj_vlax pt_id par pt_first pt_snd i bulge e_next)
(vl-load-com)
(setq
	obj_vlax (vlax-ename->vla-object (cdar dxf_ent))
	pt_id (vlax-curve-getClosestPointTo obj_vlax (trans pt_sel 1 0))
	par (vlax-curve-getParamAtPoint obj_vlax pt_id)
	pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
	pt_snd (vlax-curve-getPointAtParam obj_vlax (1+ (fix par)))
	i 0
)
(if (null pt_snd)
	(setq pt_snd (trans (vlax-curve-getEndPoint obj_vlax) 0 1))
	(setq pt_snd (trans pt_snd 0 1))
)
(cond
	((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
		(while (or (/= (caar dxf_ent) 42) (if (< i (fix par)) (setq i (1+ i))))
			(setq bulge (cdadr dxf_ent) dxf_ent (cdr dxf_ent))
		)
	)
	(T
		(setq e_next (entnext (cdar dxf_ent)))
		(repeat (fix par) (setq e_next (entnext e_next)))
		(setq bulge (cdr (assoc 42 (entget e_next))))
	)
)
(list pt_first pt_snd bulge)
)
(defun c:q_ray ( / old_osmd pt_sel ent dxf_ent typ_ent id_rad l_2pt)
(setvar "cmdecho" 0)
(setq old_osmd (getvar "osmode"))
(setvar "osmode" 2)
(initget 9)
(setq pt_sel (getpoint "\nInterroger le rayon du segment arrondi: "))
(while (null (setq ent (nentselp pt_sel)))
	(initget 9)
	(setq pt_sel (getpoint "\nInterroger le rayon du segment arrondi: "))
)
(setvar "osmode" 0)
(setq dxf_ent (entget (car ent)) typ_ent (cdr (assoc 0 dxf_ent)))
(if (eq typ_ent "VERTEX")
	(setq
		dxf_ent (entget (setq ent (cdr (assoc 330 dxf_ent))))
		typ_ent (cdr (assoc 0 dxf_ent))
	)
)
(cond
	((or (eq typ_ent "ARC") (eq typ_ent "CIRCLE"))
		(setq id_rad (cdr (assoc 40 dxf_ent)))
	)
	((or (eq typ_ent "LWPOLYLINE")
		(and
			(eq typ_ent "POLYLINE")
			(zerop (boole 1 116 (cdr (assoc 70 dxf_ent))))
		)
	 )
		(setq l_2pt (near_vertex_arr dxf_ent pt_sel))
		(if (zerop (caddr l_2pt))
			(progn
				(setq id_rad nil)
				(princ "\nCe segment est droit et ne peut être interrogé!")
			)
			(setq id_rad (/ (distance (car l_2pt) (cadr l_2pt)) (sin (* 2.0 (atan (caddr l_2pt)))) 2.0))
		)
	)
	(T
		(setq id_rad nil)
		(princ "\nCet objet ne peut être interrogé!")
	)
)
(setvar "osmode" old_osmd)
(if (eq (type id_rad) 'REAL)
	(progn
		(alert
			(strcat
				"\nRayon = "
				(rtos (abs id_rad) 2 3)
			)
		)
		(princ
			(strcat
				"\nRayon = "
				(rtos (abs id_rad) 2 3)
			)
		)
	)
)
(setvar "cmdecho" 1)
(princ)
)

(gile) · le 23 avril 2006

De mon côté, j'ai modifié ta première routine et j'ai conservé le (osnap (cadr (entsel)) "_near") plutôt que (vlax-curve-getClosestPointTo ... et je n'ai pas eu de "plantage", peut-être que les tests que j'ai fait ne sont pas assez poussés ?

Je me suis aussi inspiré d'une remarque que faisait Tramber (ici) concernant le fait que (vlax-curve-getParamAtPoint accepte aussi bien un ENAME qu'un VLA-OBJECT comme argument.

;;; CLOSEST_VERTICES Retourne la liste des coordonnées (dans le SCG)
;;; des deux sommets d'un segment de polyligne (liste entsel) ou nil

(defun closest_vertices	(ent / par pt)
 (cond
   ((and (listp ent)
  (vl-every 'numberp (cadr ent))
         (= (length (cadr ent)) 3)
  (= (type (car ent)) 'ENAME)
  (or (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
      (and
	(= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
	(zerop (logand 118 (cdr (assoc 70 (entget (car ent))))))
      )
  )
    )
    (vl-load-com)
    (setq
      pt  (trans (osnap (cadr ent) "_near") 1 0)
      ent (car ent)
      par (vlax-curve-getParamAtPoint ent pt)
    )
    (list (vlax-curve-getPointAtParam ent (fix par))
   (vlax-curve-getPointAtParam ent (1+ (fix par)))
    )
   )
 )
)

Et pour tester la routine :

;;; pt_vtx Dessine deux points sur les sommets du segment de polyligne sélectionné

(defun c:pt_vtx (/ AcDoc ModSp obj lst)
 (vl-load-com)
 (setq	AcDoc (vla-get-activedocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (vla-startUndoMark AcDoc)
 (while
   (not
     (setq
obj (entsel
      "\nSélectionnez le segment de polyligne à utiliser: "
    )
     )
   )
 )
 (cond
   ((setq lst (closest_vertices obj))
    (vla-addPoint ModSp (vlax-3d-point (car lst)))
    (vla-addPoint ModSp (vlax-3d-point (cadr lst)))
   )
   (T (princ "\nErreur: entité non valide."))
 )
 (vla-endUndoMark AcDoc)
 (princ)
)

[Edité le 23/4/2006 par (gile)]

sergeluc · le 23 avril 2006

merçi gile bonuscad serge et tramber cela va bien m'aider pour résoudre mon problème

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=9661#pid36880

bonuscad · le 29 avril 2006

peut-être que les tests que j'ai fait ne sont pas assez poussés ?

Essayes en copiant, avec par exemple, l'entité qui suit, tu comprendras mieux mon problème avec mon ancien code ou le tiens que tu as proposé. (Fais le test sur un segment d'arc)

(entmake
'(
(0 . "POLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDb2dPolyline")
(66 . 1)
(10 0.0 0.0 -771.251)
(70 . 1)
(40 . 0.0)
(41 . 0.0)
(210 -0.0430226 -0.365126 0.929964)
(71 . 0)
(72 . 0)
(73 . 0)
(74 . 0)
(75 . 0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1539.2 2741.34 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1539.44 2708.26 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . 0.0)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1562.56 2694.69 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . 0.554956)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1563.14 2673.14 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . -0.85506)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1572.97 2651.61 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . -0.524086)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "VERTEX")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbVertex")
(100 . "AcDb2dVertex")
(10 -1603.34 2739.41 -771.251)
(40 . 0.0)
(41 . 0.0)
(42 . -0.488099)
(70 . 0)
(50 . 0.0)
)
)
(entmake
'(
(0 . "SEQEND")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0") 
)
)

(gile) · le 30 avril 2006

Effectivement.

Mais le problème semble ne concerner que les polylignes2d (non optimisées),il suffit de convertir cette polyligne2d en lwpolyligne pour que tout rentre dans l'ordre.

On pourrait, soit filtrer les polylignes 2D (119 au lieu de 118) soit les convertir en lwpolylignes.

(if (and
   (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
   (= (logand 1 (cdr (assoc 70 (entget (car ent))))) 1)
 )
      (command "_.convert" "_p" "_s" (car ent) "")
    )

bonuscad · le 30 avril 2006

il suffit de convertir cette polyligne2d

Oui pourquoi pas! C'est vrai que ce genre d'entité est obsolète mais elles restent encore générées facilement par Autocad.

La commande PEDIT option Lissage vous transforme une LwPolyligne en Polyligne 2D :mad:

A moins que ceci est changé avec la version actuelle ?

Ces types de polylignes changeant sont un vrais casse-tête :casstet:

Connexion

Points proche de

Messages recommandés

Virgile_69

Invité Patrick

Serge

Invité Patrick

Virgile_69

bonuscad

Serge

bonuscad

Serge

bonuscad

bonuscad

bonuscad

(gile)

Tramber

(gile)

bonuscad

bonuscad

(gile)

sergeluc

bonuscad

(gile)

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante