Wipeout avec des arc

[Steven]

Salut,

Peut-on faire des wipeout avec des arcs?

[winfield]

Bonjour,

a ma connaissance, on ne peut pas.

Lorsque j'ai besoin de faire des wipeout avec une forme de demi-rond par ex, je crée un contour, je me retrouve avec une poly et là c'est ok.

[bonuscad]

Vu que WIPEOUT n'accepte que des segments droit, le seul moyen est de convertir tes courbures en succession de segments pour avoir un arrondi approchant.

 

En cherchant sur CadXP tu trouveras bien une routine pour faire cela.

 

Une solution parfaite (un vrai arrondi) par contre n'est pas possible :mad:

[(gile)]

Salut,

 

Un LISP bricolé à partir de la routine de transformation d'entités (cercle, ellipse ou polylignes avec arcs en polygones) utilisée dans SelByObj et d'une autre qui crée un wipeout à partir d'une liste de points

 

On peut choisir de conserver ou pas l'objet ayant servi à faire le wipeout.

 

Edit : Ajout du chargement de l'arx suite à la remarque de Bonuscad.

 

;;; OB2WO -Gilles Chanteau- 03/03/07
;;; Crée un "Wipeout" à partir d'un objet (cercle, ellipse, ou polyligne avec arcs)

(defun c:Ob2wo (/ ent lst)
 (vl-load-com)
 (if (and (setq ent (car (entsel)))
   (member (cdr (assoc 0 (entget ent)))
	   '("CIRCLE" "ELLIPSE" "LWPOLYLINE")
   )
   (setq lst (ent2ptlst ent))
   (setq ucszdir (trans '(0 0 1) 1 0 T))
     )
   (progn
     (vla-StartundoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
     )
     (makeWipeout lst)
     (initget "Oui Non")
     (if
(= (getkword "\nEffacer l'objet source ? [Oui/Non] : ")
   "Oui"
)
 (entdel ent)
     )
     (vla-EndundoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
     )
   )
 )
)

;;; ENT2PTLST
;;; Retourne la liste des sommets successifs du polygone approchant un objet courbe

(defun ent2ptlst (ent)
 (vl-load-com)
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
 )
 (cond
   ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (cons
    (trans (append (cdr (assoc 10 p_lst))
			 (list (cdr (assoc 38 (entget ent))))
		 )
		 ent
		 1
    )
    lst
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
	     (trans
		 (vlax-curve-getPointAtDist
		   obj
		   (+ (vlax-curve-getDistAtPoint
			obj
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     lst
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 lst
)


;;; MakeWipeout crée un objet "wipeout" à partir d'une liste de points

(defun MakeWipeout (pt_lst / dxf10 max_dist cen dxf_14)

 (if (not (member "acwipeout.arx" (arx)))
 (arxload "acwipeout.arx")
)
;| Ou, suivant les versions
(if (not (member "wipeout.arx" (arx)))
 (arxload "wipeout.arx")
)
|;

 (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
	    (apply 'min (mapcar 'cadr pt_lst))
	    0.0
      )
 )
 (setq
   max_dist
    (float
      (apply 'max
      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
      )
    )
 )
 (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
 (setq
   dxf14 (mapcar
    '(lambda (p)
       (mapcar '/
	       (mapcar '- p cen)
	       (list max_dist (- max_dist) 1.0)
       )
     )
    pt_lst
  )
 )
 (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
 (entmake (append (list '(0 . "WIPEOUT")
		 '(100 . "AcDbEntity")
		 '(100 . "AcDbWipeout")
		 '(90 . 0)
		 (cons 10 dxf10)
		 (list 11 max_dist 0.0 0.0)
		 (list 12 0.0 max_dist 0.0)
		 '(13 1.0 1.0 0.0)
		 '(70 . 7)
		 '(280 . 1)
		 '(71 . 2)
		 (cons 91 (length dxf14))
	   )
	   (mapcar '(lambda (p) (cons 14 p)) dxf14)
   )
 )
)

[Edité le 3/3/2007 par (gile)]

 

[Edité le 4/3/2007 par (gile)]

[bonuscad]

Au cas ou "Wipeout" n'aurait jamais utilisé auparavant, il ne se passe rien.

 

L'instruction classique:

(if (not (member "wipeout.arx" (arx))) (arxload "wipeout.arx"))

ou

(if (not (member "acwipeout.arx" (arx))) (arxload "acwipeout.arx"))

suivant les versions.

devrait être rajouté, pour que ceux qu'ils veulent essayer ne soient pas surpris. ;)

 

Bon résultats depuis le SCG et dans le SCG.

 

Je pense que pour des wipeout cela est suffisant pour l'utilisation courante, de tout façon pour mon usage j'évite le plus possible ces genres d'entités au comportement bizzare et à la gestion difficile lors des rendu papier.

[(gile)]

Merci encore à Bonuscad pour ses tests/corrections de routines faites "un peu à la va vite".

 

J'ai modifié le code pour y ajouter le chargement de l'arx et je me souviens effectivement ne pas avoir réussi à faire fonctionner "makewipeout" dans tous les SCU quand j'avais donné ce code à Joe Burke pour son LISP qui ajoute des "wipeout dans les blocs existants" (voir ici et là)

 

 

 

[Edité le 4/3/2007 par (gile)]

[(gile)]

Voilà une nouvelle version, plus aboutie.

D'après mes tests, elle fonctionne quelque soient le SCU courant et le SCO de l'objet sélectionné.

 

;;; OB2WO -Gilles Chanteau- 10/03/07
;;; Crée un "Wipeout" à partir d'un objet (cercle, ellipse, ou polyligne avec arcs)
;;; Fonctionne en 3D

(defun c:Ob2Wo (/ ent lst nor)
 (vl-load-com)
 (if (and (setq ent (car (entsel)))
   (member (cdr (assoc 0 (entget ent)))
	   '("CIRCLE" "ELLIPSE" "LWPOLYLINE")
   )
   (setq lst (ent2ptlst ent))
   (setq nor (cdr (assoc 210 (entget ent))))
     )
   (progn
     (vla-StartundoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
     )
     (makeWipeout lst nor)
     (initget "Oui Non")
     (if
(= (getkword "\nEffacer l'objet source ? [Oui/Non] : ")
   "Oui"
)
 (entdel ent)
     )
     (vla-EndundoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
     )
   )
 )
)


;;; ENT2PTLST
;;; Retourne la liste des sommets successifs du polygone approchant un objet courbe
;;; Coordonnées exprimées dans le SCO

(defun ent2ptlst (ent / obj dist n lst p_lst prec)
 (vl-load-com)
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
 )
 (cond
   ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      (vlax-get obj 'Normal)
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (cons
    (append (cdr (assoc 10 p_lst))
	    (list (cdr (assoc 38 (entget ent))))
    )
    lst
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
	     (trans
	       (vlax-curve-getPointAtDist
		 obj
		 (+ (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		    (* dist (setq n (1+ n)))
		 )
	       )
	       0
	       ent
	     )
	     lst
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 lst
)


;;; MakeWipeout crée un objet "wipeout" à partir d'une liste de points et du vecteur normal de l'objet

(defun MakeWipeout (pt_lst nor / dxf10 max_dist cen dxf_14)
 (if (not (member "acwipeout.arx" (arx)))
   (arxload "acwipeout.arx")
 )
 (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
	    (apply 'min (mapcar 'cadr pt_lst))
	    (caddar pt_lst)
      )
 )
 (setq
   max_dist
    (float
      (apply 'max
      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
      )
    )
 )
 (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
 (setq
   dxf14 (mapcar
    '(lambda (p)
       (mapcar '/
	       (mapcar '- p cen)
	       (list max_dist (- max_dist) 1.0)
       )
     )
    pt_lst
  )
 )
 (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
 (entmake (append (list '(0 . "WIPEOUT")
		 '(100 . "AcDbEntity")
		 '(100 . "AcDbWipeout")
		 '(90 . 0)
		 (cons 10 (trans dxf10 nor 0))
		 (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
		 (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
		 '(13 1.0 1.0 0.0)
		 '(70 . 7)
		 '(280 . 1)
		 '(71 . 2)
		 (cons 91 (length dxf14))
	   )
	   (mapcar '(lambda (p) (cons 14 p)) dxf14)
   )
 )
)

 

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

[Steven]

Terrible, ça marche impec' :D

 

Merci ;)