Raccords sur polylignes 3D

(gile) · le 7 novembre 2006

Suite à ce sujet, je me suis essayé à faire quelque chose d'équivalent aux raccords sur les polylignes 3D.

Le code est un peu long (j'entends déjà Didier ...), j'essayerais de faire quelque chose de plus concis, mais je voulais déjà livrer ça à la critique.

EDIT : J'avais (encore) oublié de joindre une routine : Norm_3Points

Version 1.5

;;; 3dPolyFillet -Gilles Chanteau- 21/01/07 -Version 1.5-
;;; Crée un "raccord" sur les polylignes 3D (succession de segments)

(defun c:3dPolyFillet (/	   3dPolyFillet_err	   closest_vertices
	       MakeFillet  AcDoc       ModSp	   cnt
	       prec	   rad	       ent1	   ent2
	       vxlst	   plst	       param	   obj
	      )
 (vl-load-com)

;;;*************************************************************;;;

 (defun 3dPolyFillet_err (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark AcDoc)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

;;;*************************************************************;;;

 (defun closest_vertices (obj pt / par)
   (if	(setq par (vlax-curve-getParamAtPoint obj pt))
     (list (vlax-curve-getPointAtParam obj (fix par))
    (vlax-curve-getPointAtParam obj (1+ (fix par)))
     )
   )
 )

;;;*************************************************************;;;

 (defun MakeFillet (obj   par1	 par2  /     pts1  pts2	 som   p1    p2
	     ptlst norm	 pt0   pt1   pt2   pt3	 pt4   cen   ang
	     inc   n	 vlst  nb1   nb2
	    )
   (if	(and
  (setq pts1 (closest_vertices obj par1))
  (setq pts2 (closest_vertices obj par2))
)
     (progn
(setq som (inters (car pts1) (cadr pts1) (car pts2) (cadr pts2) nil))
(if som
  (if
    (or	(equal (car pts1) som 1e-9)
	(equal (cadr pts1) som 1e-9)
	(and
	  (		     (vlax-curve-getParamAtPoint obj (car pts2))
	  )
	  (equal (vec1 (car pts1) (cadr pts1))
		 (vec1 (car pts1) som)
		 1e-9
	  )
	)
	(and
	  (		     (vlax-curve-getParamAtPoint obj (car pts1))
	  )
	  (equal (vec1 (cadr pts1) (car pts1))
		 (vec1 (cadr pts1) som)
		 1e-9
	  )
	)
    )
     (progn
       (if (		 (setq p1 (cadr pts1)
	       p2 (car pts2)
	 )
	 (setq p1 (car pts1)
	       p2 (cadr pts2)
	 )
       )
       (if (= rad 0)
	 (setq ptlst (list som))
	 (progn
	   (setq norm (norm_3pts som p2 p1)
		 pt0  (trans som 0 norm)
		 pt1  (trans p1 0 norm)
		 pt2  (trans p2 0 norm)
		 cen  (inters
			(polar pt0 (- (angle pt0 pt1) (/ pi 2)) rad)
			(polar pt1 (- (angle pt0 pt1) (/ pi 2)) rad)
			(polar pt0 (+ (angle pt0 pt2) (/ pi 2)) rad)
			(polar pt2 (+ (angle pt0 pt2) (/ pi 2)) rad)
			nil
		      )
		 pt3  (polar cen (- (angle pt1 pt0) (/ pi 2)) rad)
		 pt4  (polar cen (+ (angle pt2 pt0) (/ pi 2)) rad)
		 ang  (- (angle cen pt4) (angle cen pt3))
	   )
	   (if
	     (and (inters pt0 pt1 cen pt3 T) (inters pt0 pt2 cen pt4 T))
	      (progn
		(if (minusp ang)
		  (setq ang (+ (* 2 pi) ang))
		)
		(setq inc (/ ang prec)
		      n	  0
		)
		(repeat	(1+ prec)
		  (setq	ptlst (cons
				(polar cen (- (angle cen pt4) (* inc n)) rad)
				ptlst
			      )
			n     (1+ n)
		  )
		)
		(setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst))
	      )
	   )
	 )
       )
       (setq vlst (3d-coord->pt-lst (vlax-get obj 'Coordinates)))
       (if ptlst
	 (progn
	   (setq nb1 (vl-position p1 vlst)
		 nb2 (vl-position p2 vlst)
	   )
	   (if (= (vla-get-closed obj) :vlax-true)
	     (cond
	       ((and (equal p1 (car vlst))
		     (equal p2 (cadr (reverse vlst)))
		)
		(setq
		  vlst
		   (append (sublst vlst 1 (1+ nb2)) (reverse ptlst))
		)
	       )
	       ((and (equal p1 (cadr (reverse vlst)))
		     (equal p2 (car vlst))
		)
		(setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst))
	       )
	       ((and (equal p1 (cadr vlst))
		     (equal p2 (last vlst))
		)
		(setq
		  vlst
		   (append (reverse ptlst) (sublst vlst (1+ nb1) nil))
		)
	       )
	       ((and (equal p1 (last vlst))
		     (equal p2 (cadr vlst))
		)
		(setq vlst (append ptlst (sublst vlst (1+ nb2) nil))
		)
	       )
	       (T
		(if (			  (setq	vlst (append (sublst vlst 1 (1+ nb1))
				     ptlst
				     (sublst vlst (1+ nb2) nil)
			     )
		  )
		  (setq	vlst (append (sublst vlst 1 (1+ nb2))
				     (reverse ptlst)
				     (sublst vlst (1+ nb1) nil)
			     )
		  )
		)
	       )
	     )
	     (if (equal (car vlst) (last vlst) 1e-9)
	       (cond
		 ((and (equal p1 (cadr vlst))
		       (equal p2 (cadr (reverse vlst)))
		  )
		  (setq	vlst (append (sublst vlst 2 nb2)
				     (reverse ptlst)
				     (list (cadr vlst))
			     )
		  )
		 )
		 ((and (equal p1 (cadr (reverse vlst)))
		       (equal p2 (cadr vlst))
		  )
		  (setq	vlst (append (sublst vlst 2 nb1)
				     ptlst
				     (list (cadr vlst))
			     )
		  )
		 )
	       )
	       (if (			 (setq vlst (append (sublst vlst 1 (1+ nb1))
				    ptlst
				    (sublst vlst (1+ nb2) nil)
			    )
		 )
		 (setq vlst (append (sublst vlst 1 (1+ nb2))
				    (reverse ptlst)
				    (sublst vlst (1+ nb1) nil)
			    )
		 )
	       )
	     )
	   )
	   (vlax-put obj 'Coordinates (apply 'append vlst))
	 )
	 (prompt "\nLe rayon spécifié est trop grand.")
       )
     )
     (prompt "\nLes segments sont divergents.")
  )
  (prompt "\nLes segments ne sont pas concourants.")
)
     )
     (prompt "\nLe rayon spécifié est trop grand.")
   )
 )




;;;*************************************************************;;;

 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (setq	m:err	*error*
*error*	3dPolyFillet_err
 )
 (vla-StartUndoMark AcDoc)

 ;; Saisie des données
 (if (not (vlax-ldata-get "3dFillet" "Prec"))
   (vlax-ldata-put "3dFillet" "Prec" 20)
 )
 (if (not (vlax-ldata-get "3dFillet" "Rad"))
   (vlax-ldata-put "3dFillet" "Rad" 10.0)
 )
 (prompt (strcat "\nParamètres courants.\tSegments: "
	  (itoa (vlax-ldata-get "3dFillet" "Prec"))
	  "\tRayon: "
	  (rtos (vlax-ldata-get "3dFillet" "Rad"))
  )
 )
 (setq cnt 1)
 (while (= 1 cnt)
   (initget 1 "Segments Rayon")
   (setq ent1
   (entsel
     "\nSélectionnez le premier segment ou [segments/Rayon]: "
   )
   )
   (cond
     ((not ent1)
      (prompt "\nAucun objet sélectionné.")
     )
     ((= ent1 "Segments")
      (initget 6)
      (if (setq prec
	  (getint
	    (strcat "\nSpécifiez le nombre de segments pour les arcs 			    (itoa (vlax-ldata-get "3dFillet" "Prec"))
		    ">: "
	    )
	  )
   )
 (vlax-ldata-put "3dFillet" "Prec" prec)
      )
     )
     ((= ent1 "Rayon")
      (initget 4)
      (if (setq rad
	  (getdist
	    (strcat "\nSpécifiez le rayon 			    (rtos (vlax-ldata-get "3dFillet" "Rad"))
		    ">: "
	    )
	  )
   )
 (vlax-ldata-put "3dFillet" "Rad" rad)
      )
     )
     ((and
 (= (cdr (assoc 0 (entget (car ent1)))) "POLYLINE")
 (= (logand 8 (cdr (assoc 70 (entget (car ent1))))) 8)
      )
      (setq cnt 0)
     )
     (T
      (prompt "\nL'objet sélectionné n'est pas une polyligne 3D.")
     )
   )
 )
 (setq	prec (vlax-ldata-get "3dFillet" "Prec")
rad  (vlax-ldata-get "3dFillet" "Rad")
 )
 (while (not ent2)
   (initget 1 "Tous")
   (setq ent2 (entsel "\nSélectionnez le deuxième segment ou [Tous]: "))
   (if	(not (or (= ent2 "Tous") (eq (car ent1) (car ent2))))
     (progn
(prompt
  "\nLe segment sélectionné n'est pas sur le même objet"
)
(setq ent2 nil)
     )
   )
 )
 (setq obj (vlax-ename->vla-object (car ent1)))
 (if (= ent2 "Tous")
   (progn
     (setq vxlst (3d-coord->pt-lst (vlax-get obj 'Coordinates))
    param 0.5
     )
     (repeat (if (= (vla-get-closed obj) :vlax-true) (length vxlst) (1- (length vxlst)))
(setq plst  (append plst (list (vlax-curve-getPointAtParam obj param)))
      param (1+ param)
)
     )
     (if (or (= (vla-get-closed obj) :vlax-true)
      (equal (car vxlst) (last vxlst) 1e-9)
      )
(setq plst (cons (last plst) plst))
)
     (setq cnt 0)
  (repeat (1- (length plst))
    (MakeFillet obj (nth cnt plst) (nth (setq cnt (1+ cnt)) plst))
  )
   )
   (MakeFillet	obj
	(trans (osnap (cadr ent1) "_nea") 1 0)
	(trans (osnap (cadr ent2) "_nea") 1 0)
   )
 )
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;;*************************************************************;;;
;;;*********************** SOUS ROUTINES ***********************;;;


;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points

(defun norm_3pts (org xdir ydir / norm)
 (foreach v '(xdir ydir)
   (set v (mapcar '- (eval v) org))
 )
 (if (inters org xdir org ydir)
   (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm)))
    (setq norm (list (-	(* (cadr xdir) (caddr ydir))
			(* (caddr xdir) (cadr ydir))
		     )
		     (-	(* (caddr xdir) (car ydir))
			(* (car xdir) (caddr ydir))
		     )
		     (-	(* (car xdir) (cadr ydir))
			(* (cadr xdir) (car ydir))
		     )
	       )
    )
   )
 )
)

;;;*************************************************************;;;

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

;;;*************************************************************;;;

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)

(defun sublst (lst start leng / rslt)
 (if (not (    (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt	(cons (nth (1- start) lst) rslt)
  start	(1+ start)
   )
 )
 (reverse rslt)
)

;;;*************************************************************;;;

;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2

(defun vec1 (p1 p2)
 (if (not (equal p1 p2 1e-009))
   (mapcar '(lambda (x1 x2)
       (/ (- x2 x1) (distance p1 p2))
     )
    p1
    p2
   )
 )
)

;;;*************************************************************;;;

;;; BUTLAST Liste sans le dernier élément

(defun butlast (lst)
 (reverse (cdr (reverse lst)))
)

[Edité le 7/11/2006 par (gile)][Edité le 8/11/2006 par (gile)][Edité le 8/11/2006 par (gile)][Edité le 9/11/2006 par (gile)][Edité le 14/11/2006 par (gile)][Edité le 10/12/2006 par (gile)][Edité le 11/12/2006 par (gile)]

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

(gile) · le 8 novembre 2006

Déjà une nouvelle version.

Accepte un rayon de 0.

Possiblité de raccorder des segments non adjacents.

Toutefois, il faut que ces segments soient sur des droites concourantes (coplanaires et non parallèles).

Les segments doivent appartenir à la même polyligne 3D.

Pour joindre des polylignes 3D, on peut utiliser : Join3dPoly

(gile) · le 9 novembre 2006

Version 1.2

Les dernières valeurs entrées pour le nombre de segments et le rayon des arcs sont conservées dans le dessin et seront reproposées par défaut au prochain lancement de la commande, et ce, même après fermeture et enregistrement du dessin.

(gile) · le 14 novembre 2006

Version 1.3

Ajout d'un test logique : seuls les segments convergents sont traités.

(gile) · le 10 décembre 2006

Version 1.4

Ajout d'une option : Tous ou T à entrer à la place de la sélection du deuxième segment pour faire le même "raccord" entre tous les segments de la poly 3D.

[Edité le 11/12/2006 par (gile)]

(gile) · le 21 janvier 2007

Version 1.5

Correction d'un bug avec les polylignes fermées (et celles dont le premier et le dernier sommet sont confondus).

Connexion

Raccords sur polylignes 3D

Messages recommandés

(gile)

(gile)

(gile)

(gile)

(gile)

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante