(defun round (num prec)
	(if (zerop (setq prec (abs prec)))
		num
		(* prec (fix ((if (minusp num) - +) (/ num prec) 0.5)))
	)
)

(defun c:Tracage ( / p1 p2 key pt_sel ss ent obj_lw param_pt new_param pt lst_pt lst_gr)
	(initget 1)
	(setq
		p1 (getpoint "\nPoint de depart : ")
		new_param nil
		ent nil
		lst_pt nil
		lst_gr nil
	)
	(while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25))
	(cond
		((eq (car key) 5)
		;;; Récupère le point sélectionné de key par grread
		(setq pt_sel (osnap (list (caadr key) (cadadr key)) "_near"))
		; si pt_sel existe alors
		(if pt_sel
			(progn
			;;; Sélectionne la polyligne en dessous du point en cours
			(setq ss (ssget "_C" pt_sel pt_sel '((0 . "LWPOLYLINE"))))
				(if ss (setq ent (ssname ss 0)))
			);fin progn
		)
		(cond
			;;; si entité alors
			(ent 
			;;; Alors transformation en objet vla l'entité lwpolyligne en cours
			(setq
				obj_lw (vlax-ename->vla-object ent)
				pt_sel (vlax-curve-getClosestPointTo obj_lw (trans (cadr key) 1 0))
			)
			(cond
				;;; si nouveau pt_sel alors
				(pt_sel
				(setq
					param_pt (vlax-curve-getParamAtPoint obj_lw pt_sel)
					param_pt (round param_pt 1.0)
				)
				(cond
					(new_param
						(setq pt (vlax-curve-getPointAtParam obj_lw param_pt))
						(if (and (not (eq param_pt new_param)) (not (member pt lst_pt)))
							(progn
							(setq lst_pt (cons (trans pt 0 1) lst_pt))
							(setq p2 (trans pt 0 1))
							(setq lst_gr (append (cons 1 (list p1 p2)) lst_gr))
							(grvecs lst_gr)
							(setq p1 p2)
							)
						)
					)
				)
				(setq new_param param_pt)
				)
			)
			)
		)
		)
		((member key '((2 117)(2 85)))
		(if lst_gr
			(setq
			lst_gr (cdddr lst_gr)
			lst_pt (cdr lst_pt)
			p1 (car lst_pt)
			)
		)
		(redraw)
		(grvecs lst_gr)
		)
		(T
		(if lst_gr (grvecs lst_gr))
		)
	)
	)
	(redraw)
	(cond
	(lst_pt
		(setvar "CMDECHO" 0)
		(command "_.pline")
		(foreach n lst_pt (command "_none" n))
		(command "")
		(setvar "CMDECHO" 1)
		(sssetfirst nil (ssadd (entlast)))
	)
	)
	(prin1)
)