Tangente au point

[(gile)]

Salut,

 

AutoCAD fournit un mode d'accrochage aux objets "Tangente", mais l'objet de ce LISP est de dessiner une ligne sur la tangente à une courbe à partir du (ou des) point(s) spécifié(s) sur cette courbe.

 

Il s'agit aussi d'un exemple d'utilisation de la fonction LISP grread pour modifier dynamiquement un objet suivant les coordonnées du pointeur et récupérer les entrées au clavier.

Pour permettre un affichage cohérent quelques soient la vue courante, le SCU courant, et la direction de la tangente, ce LISP utilise des routines de calcul vectoriel qui pourront être utiles aux lispeurs 3d.

 

;; TAP
;; Crée une ligne sur la tangente à la courbe au point spécifié.

(defun c:tap (/ obj)
 (vl-load-com)
 (vla-StartUndoMark (vla-get-activeDocument (vlax-get-acad-object)))
 (if (and
(setq obj (car (entsel "\nSélectionnez une courbe: ")))
(vlax-curve-getEndParam obj)
     )
   (vl-catch-all-apply
     '(lambda (/ start par vec pt ratio line elst start loop)
 (while	(setq start (getpoint "\nSpécifiez le point de tangence: "))
   (if (setq par (vlax-curve-getParamAtPoint
		   obj
		   (setq start (trans start 1 0))
		 )
       )
     (progn
       (setq
	 ;; vecteur directeur de la tangente
	 vec   (vunit (vlax-curve-getFirstDeriv obj par))
	 
	 ;; projection du point sur le plan du SCU
	 pt    (trans (UCSProjectAboutView start) 0 1)
	 
	 ;; rapport entre la longueur du vecteur et celle de sa projection sur le SCU
	 ratio (/ 1
		  (distance (UCSProjectAboutView '(0 0 0))
			    (UCSProjectAboutView vec)
		  )
	       )
	 ;; ligne de longueur 0
	 line  (entmakex
		 (list
		   '(0 . "LINE")
		   (cons 10 start)
		   (cons 11 start)
		 )
	       )
	 elst  (entget line)
	 loop  T
       )
       (princ "\nSpécifiez la longueur ou [annUler/Inverser]: ")
       (if
	 (vl-catch-all-error-p
	   (vl-catch-all-apply
	     '(lambda (/ gr len end str)
		(while
		  (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
		   (cond
		     ;; modification de la ligne en fonction de la position du pointeur
		     ((= 5 (car gr))
		      (setq len	(* ratio (distance pt (cadr gr)))
			    end	(mapcar
				  (function
				    (lambda (x1 x2)
				      (+ x1 (* len x2))
				    )
				  )
				  start
				  vec
				)
		      )
		      (entmod (subst (cons 11 end)
				     (assoc 11 elst)
				     elst
			      )
		      )

		      ;; affichage dynamique de la longueur dans la barre d'état
		      (grtext -1 (rtos len))
		     )
		     
		     ;; clic droit
		     ((member (car gr) '(11 25))
		      (entdel line)
		      (setq loop nil
			    line nil
		      )
		     )
		     
		     ;; Entrée ou Espace
		     ((member (cadr gr) '(13 32))
		       (cond
			 ;; longueur valide
			 ((and str (numberp (distof str)))
			  (setq	end  (mapcar
				       (function
					 (lambda (x1 x2)
					   (+ x1 (* (distof str) x2))
					 )
				       )
				       start
				       vec
				     )
				loop nil
			  )
			  (entmod (subst (cons 11 end)
					 (assoc 11 elst)
					 elst
				  )
			  )
			 )
			 
			 ;; Inverser
			 ((= (strcase str) "I")
			  (setq	vec (mapcar '- vec)
				str nil
			  )
			  (princ (chr 8))
			  (princ (chr 32))
			 )
			 
			 ;; annUler
			 ((= (strcase str) "U")
			  (entdel line)
			  (setq	loop nil
				line nil
			  )
			 )
			 
			 ;; entrée non valide
			 (T
			  (princ
			    "\nNécessite un nombre valide ou une saisie au pointeur.
			     \nSpécifiez la longueur ou [annUler/Inverser]: "
			  )
			  (setq str "")
			 )
		       )
		     )
		     
		     ;; Récupération des entrée au clavier
		     (T
		      ;; retour/effacer
		      (if (= (cadr gr) 8)
			(or
			  (and
			    str
			    (/= str "")
			    (setq str (substr str 1 (1- (strlen str))))
			    (princ (chr 8))
			    (princ (chr 32))
			  )
			  (setq str nil)
			)
			(or
			  (and str
			       (setq str (strcat str (chr (cadr gr))))
			  )
			  (setq str (chr (cadr gr)))
			)
		      )

		      ;; affichage sur la ligne commande
		      (and str (princ (chr (cadr gr))))
		     )
		   )
		)
	      )
	   )
	 )
	  (and (entdel line) (setq line nil))
       )
     )
   )
 )
      )
   )
 )
 (grtext)
 (vla-EndUndoMark (vla-get-activeDocument (vlax-get-acad-object)))
 (princ)
)

;;======================= SOUS ROUTINES =======================;;

;;VXV Retourne le produit scalaire (réel) de deux vecteurs

(defun vxv (v1 v2)
 (apply '+ (mapcar '* v1 v2))
)


;;; VUNIT Retourne le vecteur unitaire d'un vecteur

(defun vunit (v)
 ((lambda (l)
    (if (/= 0 l)
      (mapcar (function (lambda (x) (/ x l))) v)
    )
  )
   (distance '(0 0 0) v)
 )
)

;;; ILP Retourne le point d'intersection de la droite définie par p1 p2
;;; et du plan défini par un point et sa normale.

(defun ilp (p1 p2 org nor / scl)
 (if (and
(/= 0 (setq scl (vxv nor (mapcar '- p2 p1))))
(setq scl (/ (vxv nor (mapcar '- p1 org)) scl))
     )
   (mapcar (function (lambda (x1 x2) (+ (* scl (- x1 x2)) x1)))
    p1
    p2
   )
 )
)

;; UCSProjectAboutView
;; Projette un point sur le plan du SCU courant suivant la vue courante
;;
;; Argument
;; pt : le point à projeter (coordonneés SCG)
;;
;; Retour : le point sur le plan du SCU courant (coordonneés SCG)

(defun UCSProjectAboutView (pt)
 (ilp
   pt
   ((lambda (p)
      (trans (list (car p)
	    (cadr p)
	    (1+ (caddr p))
      )
      2
      0
      )
    )
     (trans pt 0 2)
   )
   (trans '(0 0 0) 1 0)
   (trans '(0 0 1) 1 0 T)
 )
) 

[richard-c]

salut,

 

j'aime bien,

 

je verrai lundi son utilité dans mon métier, (tout en sachant que dans 2 semaines et demie, je suis en congés jusqu'au . . . 11 septembre, et le 12 les trés grandes vacances.

 

Bon WE

[lili2006]

Bonsoir à toutes et tous,

 

J'ai testé également. On ne peut dessiner la ligne que dans un sens, c'est surement normal, mais pourquoi (gile) ?

 

Merci d'avance.

 

En tous cas, encore un outil très pratique.

[(gile)]

Salut,

 

On ne peut dessiner la ligne que dans un sens,

 

Regarde la ligne de commande: "Spécifiez la longueur ou [annUler/Inverser]:"

Tu tapes : i et le sens de la ligne s'inverse.

[lili2006]

Re,

 

Ok (gile), je n'avais pas l'info avec le dyn (F12) et ayant ma ligne de commande en palette masquée, je n'avais pas vu les options.

 

Tout est parfait alors !

 

Encore bravo pour cet utilitaire qui peut vite devenir indispensable,...