Bissectrice et médiatrice

(gile) · le 20 janvier 2007

Jusque là j'utilisais, pour dessiner la bissectrice de deux segments le LISP "Bissect" de Bonuscad (à peine modifié à ma sauce).

Là j'ai décidé de faire quelque chose de plus personnel.

Encore merci à Bonuscad pour tout ce qu'il m'a apporté (comme par exemple l'utilisation de grread).

Le LISP ci-dessous permet de dessiner la bissectrice de deux segments rectilignes, ces segments peuvent être des lignes, des droites, des demi-droites, des segments de polylignes, des côtés de régions, de blocs ou de faces, des arrêtes de solides.

Les deux segments peuvent appartenir à deux entités différentes et ne pas être sécants.

Petite restriction, c'est une commande 2D (comme polyligne ou cercle) : les deux segments doivent être dans un plan parallèle au plan XY du SCU courant.

Edit : Ajout de "ang

;;; C:BISSECTRICE 10/02/07
;;; Crée une ligne sur la bissectrice de l'angle formé par les deux segments sélectionnés.

(defun c:bissectrice
      (/ erreur acdoc space e1 e2 l1 l2 p1 p1e p1m p2 p2e p2m som ang gr pe)

 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (redraw)
   (setq *error* m:err
  m:err	nil
   )
 )

 (setq	acdoc	(vla-get-ActiveDocument (vlax-get-acad-object))
space	(if (= 1 (getvar "CVPORT"))
	  (vla-get-PaperSpace acdoc)
	  (vla-get-ModelSpace acdoc)
	)
m:err	*error*
*error*	erreur
 )
 (while (not
   (setq e1 (entsel "\nSélectionnez le premier segment: "))
 )
 )
 (while (not
   (setq e2 (entsel "\nSélectionnez le second segment: "))
 )
 )
 (setq	l1 (entget (car e1))
l2 (entget (car e2))
p1 (osnap (cadr e1) "_near")
p2 (osnap (cadr e2) "_near")
 )
 (if
   (and
     (or
(and (member (cdr (assoc 0 l1)) '("XLINE" "RAY"))
     (setq p1m (mapcar '+ p1 (trans (cdr (assoc 11 l1)) 0 1 T)))
     (setq p1e (mapcar '- p1 (trans (cdr (assoc 11 l1)) 0 1 T)))
)
(and
  (setq p1m (osnap (cadr e1) "_midpoint"))
  (setq p1e (osnap (cadr e1) "_endpoint"))
)
     )
     (or
(and (member (cdr (assoc 0 l2)) '("XLINE" "RAY"))
     (setq p2m (mapcar '+ p2 (trans (cdr (assoc 11 l2)) 0 1 T)))
     (setq p2e (mapcar '- p2 (trans (cdr (assoc 11 l2)) 0 1 T)))
)
(and
  (setq p2m (osnap (cadr e2) "_midpoint"))
  (setq p2e (osnap (cadr e2) "_endpoint"))
)
     )
   )
    (if (vl-every '(lambda (x) (equal (caddr p1) (caddr x) 1e-009))
	   (list p1m p1e p2 p2m p2e)
 )
      (if (and	(null (inters p1 p1m p1 p1e))
	(null (inters p2 p2m p2 p2e))
   )
 (if (setq som (inters p1 p1e p2 p2e nil))
   (progn
     (setq ang (ang	     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3))
       (if (= 5 (car gr))
	 (progn
	   (redraw)
	   (setq pe
		  (polar
		    som
		    (if
		      (				 (ang				 pi
		      )
		       (+ ang pi)
		       ang
		    )
		    (distance som (cadr gr))
		  )
	   )
	   (grdraw som pe -1)
	 )
       )
     )
     (vla-StartUndoMark acdoc)
     (vla-addLine
       space
       (vlax-3d-point (trans som 1 0))
       (vlax-3d-point (trans pe 1 0))
     )
     (redraw)
     (vla-EndUndoMark acdoc)
   )
   (princ "\nErreur: segments parallèles")
 )
 (princ "\nErreur: segment non linéaire")
      )
      (princ
 "\nErreur: segments non coplanaires ou non parallèles au plan du SCU courant"
      )
    )
    (princ "\nErreur: entité non valide")
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; Ang
(defun ang  (if (and (    ang
   (ang  )
)

Et dans la foulée, un autre pour dessiner la médiatrice entre deux points.

;;; MEDIATRICE Crée une ligne perpendiculaire à partir du milieu de deux points.

(defun c:mediatrice (/ erreur doc sp pt1 pt2 dep gr pe)

 (defun erreur	(msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (redraw)
   (setq *error* m:err
  m:err	nil
   )
 )

 (setq	m:err	*error*
*error*	erreur
doc	(vla-get-ActiveDocument (vlax-get-acad-object))
sp	(if (= (getvar "CVPORT") 1)
	  (vla-get-PaperSpace doc)
	  (vla-get-ModelSpace doc)
	)
 )
 (initget 1)
 (setq pt1 (getpoint "\nPremier point: "))
 (initget 1)
 (setq pt2 (getpoint pt1 "\nSecond point: "))
 (if (equal (caddr pt1) (caddr pt2) 1e-009)
   (progn
     (setq dep (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) pt1 pt2))
     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3))
(redraw)
(setq pe (polar
	   dep
	   (if (			  (ang			  pi
	       )
	     (+ (angle dep pt1) (/ pi 2))
	     (- (angle dep pt1) (/ pi 2))
	   )
	   (distance dep (cadr gr))
	 )
)
(grdraw dep pe -1)
     )
     (vla-StartUndoMark doc)
     (vla-addLine
sp
(vlax-3d-point (trans dep 1 0))
(vlax-3d-point (trans pe 1 0))
     )
     (redraw)
     (vla-EndUndoMark doc)
   )
   (prompt
     "Les points ne sont pas dans un plan parallèle au plan du SCU courant."
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; Ang
(defun ang  (if (and (    ang
   (ang  )
)

[Edité le 20/1/2007 par (gile)][Edité le 21/1/2007 par (gile)]

[Edité le 10/2/2007 par (gile)]

lili2006 · le 1 juillet 2008

Bonsoir à toutes et tous,

On a pas forcément l'habitude de construire ce genre de figure (du moins en Génie Civil), ou bien et surement surtout, on y pense pas.

Marche super,

Merci (gile)

(gile) · le 1 juillet 2008

On a pas forcément l'habitude de construire ce genre de figure (du moins en Génie Civil)

Personnellement, je ne passe pas une journée sur AutoCAD sans utiliser au moins une fois une de ces commandes ou les deux (menuiserie / décor)

[Edité le 1/7/2008 par (gile)]

lili2006 · le 2 juillet 2008

Bonjour à toutes et tous,

Il y a suremment aussi des applications dans d'autres domaines techniques, mais

ou bien et surement surtout, on y pense pas.

Matt666 · le 2 juillet 2008

De toute façon y en a que pour le Vlisp dans c'forum !!! :mad: :mad: :mad:

(gile) · le 2 juillet 2008

De toute façon y en a que pour le Vlisp dans c'forum !!! :mad: :mad: :mad:

J'ai extirpé de mes archives ces 2 versions "pur AutoLISP" qui fonctionne avec grread.

;;; C:BISSECTRICE -Gilles Chanteau- (maj 23/04/07) Version AutoLISP
;;; Crée une ligne sur la bissectrice de l'angle formé par les deux segments sélectionnés.
;;; La longueur de la ligne est entrée au clavier ou spécifiée à l'aide du pointeur.

(defun c:bissectrice
	     (/	*error*	e1 e2 l1 l2 p1 p1e p1m p2 p2e p2m som
	      ang gr pe	str)

 (defun *error* (msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (grtext)
   (redraw)
 )

 (while (not
   (setq e1 (entsel "\nSélectionnez le premier segment: "))
 )
 )
 (while (not
   (setq e2 (entsel "\nSélectionnez le second segment: "))
 )
 )
 (setq	l1 (entget (car e1))
l2 (entget (car e2))
p1 (osnap (cadr e1) "_near")
p2 (osnap (cadr e2) "_near")
 )
 (if
   (and
     (or
(and (member (cdr (assoc 0 l1)) '("XLINE" "RAY"))
     (setq p1m (mapcar '+ p1 (trans (cdr (assoc 11 l1)) 0 1 T)))
     (setq p1e (mapcar '- p1 (trans (cdr (assoc 11 l1)) 0 1 T)))
)
(and
  (setq p1m (osnap (cadr e1) "_midpoint"))
  (setq p1e (osnap (cadr e1) "_endpoint"))
)
     )
     (or
(and (member (cdr (assoc 0 l2)) '("XLINE" "RAY"))
     (setq p2m (mapcar '+ p2 (trans (cdr (assoc 11 l2)) 0 1 T)))
     (setq p2e (mapcar '- p2 (trans (cdr (assoc 11 l2)) 0 1 T)))
)
(and
  (setq p2m (osnap (cadr e2) "_midpoint"))
  (setq p2e (osnap (cadr e2) "_endpoint"))
)
     )
   )
    (if (vl-every '(lambda (x) (equal (caddr p1) (caddr x) 1e-009))
	   (list p1m p1e p2 p2m p2e)
 )
      (if (and	(null (inters p1 p1m p1 p1e))
	(null (inters p2 p2m p2 p2e))
   )
 (if (setq som (inters p1 p1e p2 p2e nil))
   (progn
     (setq ang	(ang		   loop	T
     )
     (princ "\nSpécifiez la longueur: ")
     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
       (cond
	 ((= 5 (car gr))
	  (redraw)
	  (setq	pe
		 (polar
		   som
		   (if
		     (				(ang				  (- (angle som (cadr gr)) (+ (/ pi 2) ang))
			)
			pi
		     )
		      (+ ang pi)
		      ang
		   )
		   (distance som (cadr gr))
		 )
	  )
	  (grdraw som pe -1)
	  (grtext -1 (rtos (distance som (cadr gr))))
	 )
	 ((member (cadr gr) '(13 32))
	  (if (and str (numberp (read str)))
	    (setq pe   (polar
			 som
			 (angle som pe)
			 (distof str)
		       )
		  loop nil
	    )
	    (progn
	      (princ
		"\nNécessite un nombre valide ou une saisie au pointeur.
	        \nSpécifiez la longueur: "
	      )
	      (setq str "")
	    )
	  )
	 )
	 (T
	  (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)))
	    )
	  )
	  (and str (princ (chr (cadr gr))))
	 )
       )
     )
     (entmake
       (list
	 '(0 . "LINE")
	 (cons 10 (trans som 1 0))
	 (cons 11 (trans pe 1 0))
       )
     )
     (grtext)
     (redraw)
   )
   (princ "\nErreur: segments parallèles")
 )
 (princ "\nErreur: segment non linéaire")
      )
      (princ
 "\nErreur: segments non coplanaires ou non parallèles au plan du SCU courant"
      )
    )
    (princ "\nErreur: entité non valide")
 )
 (princ)
)

;; Mediatrice -Gilles Chanteau- (maj 23/04/07) Version AutoLISP
;; Crée une ligne sur la médiatrice du segment défini par 2 points
;; La longueur de la ligne est entrée au clavier ou à l'aide du pointeur.

(defun c:mediatrice (/ *error* doc sp pt1 pt2 dep loop str gr pe ch)

 (defun *error*	(msg)
   (if	(= msg "Fonction annulée")
     (princ "\n*Annuler*")
     (princ (strcat "\nErreur: " msg))
   )
   (grtext)
   (redraw)
 )

 (initget 1)
 (setq pt1 (getpoint "\nPremier point: "))
 (initget 1)
 (setq pt2 (getpoint pt1 "\nSecond point: "))
 (if (equal (caddr pt1) (caddr pt2) 1e-009)
   (progn
     (setq dep	 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) pt1 pt2)
    loop T
     )
     (princ "\nSpécifiez la longueur: ")
     (while (and (setq gr (grread T 12 0)) (/= (car gr) 3) loop)
(cond
  ((= (car gr) 5)
   (redraw)
   (setq pe
	  (polar
	    dep
	    (if
	      (			 (ang			 )
		 pi
	      )
	       (+ (angle dep pt1) (/ pi 2))
	       (- (angle dep pt1) (/ pi 2))
	    )
	    (distance dep (cadr gr))
	  )
   )
   (grdraw dep pe -1)
   (grtext -1 (rtos (distance dep (cadr gr))))
  )
  ((member (cadr gr) '(13 32))
   (if (and str (numberp (read str)))
     (setq pe	(polar
		  dep
		  (angle dep pe)
		  (distof str)
		)
	   loop	nil
     )
     (progn
       (princ
	 "\nNécessite un nombre valide ou une saisie au pointeur.
	 \nSpécifiez la longueur: "
       )
       (setq str "")
     )
   )
  )
  (T
   (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)))
     )
   )
   (and str (princ (chr (cadr gr))))
  )
)
     )
     (entmake
(list
  '(0 . "LINE")
  (cons 10 (trans dep 1 0))
  (cons 11 (trans pe 1 0)))
)
     (grtext)
     (redraw)
   )
   (prompt
     "Les points ne sont pas dans un plan parallèle au plan du SCU courant."
   )
 )
 (princ)
)

;;; Ang
(defun ang  (if (and (    ang
   (ang  )
)

Matt666 · le 2 juillet 2008

:o :) :cool: :D :thumbup:

Très très, très fort, ce Gile !!!

DE----MENT ! Je regarde ça au plus vite !!!

Merciii !

Connexion

Bissectrice et médiatrice

Messages recommandés

(gile)

Lien vers le commentaire

Partager sur d’autres sites

lili2006

Lien vers le commentaire

Partager sur d’autres sites

(gile)

Lien vers le commentaire

Partager sur d’autres sites

lili2006

Lien vers le commentaire

Partager sur d’autres sites

Matt666

Lien vers le commentaire

Partager sur d’autres sites

(gile)

Lien vers le commentaire

Partager sur d’autres sites

Matt666

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante