Obtenir les sommets et l\'arrondi d\'un segment de polyligne

[bonuscad]

Grâce à la suggestion de Gilles, j'ai refondu une fonction que j'avais proposée.

Celle-ci semble fonctionner correctement à partir des versions 2002 (testé jusqu' à 2005, sous 2000 des problème persistent)

 

Cette fonction retourne les sommets les plus proches (dans le SCU courrant) du segment de Polylignes ou LwPolyligne, ainsi que l'arrondi qui lui est affecté sous forme de liste ((1er point) (2ème point) arrondi)

 

Voici donc le corp principale de la fonction qui doit être utilisé sous la forme

(near_vertex (entsel "\nChoisir un segment de polyligne: "))

 

(defun near_vertex (obj / dxf_obj obj_vlax pt_sel par i pt_first pt_snd bulge e_next)
(cond
	((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE")
		(and
			(eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
			(zerop (boole 1 112 (cdr (assoc 70 dxf_obj))))
		)
	 )
		(vl-load-com)
		(setq
			obj_vlax (vlax-ename->vla-object (car obj))
			pt_sel
			(vlax-curve-getClosestPointToProjection
				obj_vlax
				(trans (cadr obj) 1 0)
				(mapcar '- (trans (getvar "VIEWDIR") 1 0) (trans '(0 0 0) 1 0))
			)
			par (vlax-curve-getParamAtPoint obj_vlax pt_sel)
			i 0
		)
		(if (>= par (vlax-curve-getEndParam obj_vlax)) (setq par (1- par)))
			(setq pt_first (trans (vlax-curve-getPointAtParam obj_vlax (fix par)) 0 1)
		)
		(if (= (1+ (fix par)) (vlax-curve-getEndParam obj_vlax))
			(setq pt_snd (trans (vlax-curve-getEndPoint obj_vlax) 0 1))
			(setq pt_snd (trans (vlax-curve-getPointAtParam obj_vlax (1+ (fix par))) 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))))
			)
		)
		(list pt_first pt_snd bulge)
	)
	(T
		(princ "\nN'est pas une polyligne2D valable pour cette fonction!")
		nil
	)
)
)

 

Cette fonction ouvre de nombreuses possibilités pour ceux qui voudraient exploités ces informations en lisp.

 

Voici par exemple une fonction test pour la tester:

(defun c:test ( / ent pair_pt)
(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)
	)
)
(while (not (setq ent (entsel "\nChoix d'une polyligne "))))
(setq pair_pt (near_vertex ent))
(if pair_pt
	(progn
		(redraw)
		(draw_pt (car pair_pt))
		(draw_pt (cadr pair_pt))
		(print pair_pt)
	)
)
(prin1)
)

 

Ou encore un exemple simple plus concret pour interroger le rayon d'un segment d'arc

(defun c:q_ray ( / old_osmd pt_sel ent dxf_ent typ_ent id_rad l_2pt)
(setvar "cmdecho" 0)
(while (not (setq ent (entsel "\nInterroger le rayon du segment arrondi: "))))
(setq dxf_ent (entget (car 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") (eq typ_ent "POLYLINE"))
		(if (setq l_2pt (near_vertex ent))
			(if (zerop (caddr l_2pt))
				(progn
					(princ "\nCe segment est droit!")
					(setq id_rad nil)
				)
				(setq id_rad (/ (distance (car l_2pt) (cadr l_2pt)) (sin (* 2.0 (atan (caddr l_2pt)))) 2.0))
			)
			(setq id_rad nil)
		)
	)
	(T
		(setq id_rad nil)
		(princ "\nCet objet ne peut être interrogé!")
	)
)
(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)
)

 

NB: Bien sur la fonction (near_vertex) doit être d'abord chargée ou intégré au lisp que vous construirez.

[(gile)]

Ça marche très bien avec 2007.

 

C'est une super idée que de récupérer aussi le bulge ;)

[bonuscad]

Merci à toi Gilles car c'est toi qui m'a aidé a neutraliser l'usage de (osnap "_near") qui posait beaucoup de problème.

 

Ta fonction de remplacement fonctionne à merveille, sauf sur une 2000 (dans le cas d'un SCU non parrallèle) il y a un décalage sur le point retourné.

Mais j'oubli cette version capricieuse, et je suis content de savoir que cela fonctionne sous 2007, car c'est une fonction qui me sert beaucoup pour d'autre lisps.

 

le code proposé s'est alourdi a cause de la 2002 qui avait un comportement différent avec (vlax-curve-getPointAtParam).

Ceci pour info, si un jour tu dois chercher un bug avec une 2002 avec cette fonction. ;)