Cercles ou Ellipse -> Arcs & vice-versa

(gile) · le 9 novembre 2005

Je n'ai pas eu beaucoup de temps ces derniers jours, mais voilà la suite du feuilleton commencé dans Transformer un arc en cercle et continué dans Arc->Ellipse ou Arc->Cercle.

J'ai regroupé en une seule commande les conversions d'arcs en cercles ou ellipses ou de cercles et d'ellipses en arcs.

Suivant l'objet sélectionné la conversion se fait automatiquement ou demande de spécifier les angles de départ et de fin pour les arcs. Les propriétés des objets (calque, couleur, type de ligne...) sont conservées.

La principale difficulté que j'ai rencontrée a été la conversion des angles spécifiés en" paramètres" pour les arcs elliptiques (code dxf 41 et 42).

-Le 12/11/05 à 10h11 - Ajout de la définition de (remove-if) et remplacement des (vl-remove-if) par (remove-if) pour la compatibilité avec les logiciels IntelliCAD, IntelliDESK...

;;; ACE - Convertit un arc elliptique en ellipse, un arc de cercle en cercle et,
;;; inversement, un cercle ou une ellipse en arc d'après les angles spécifiés.

(defun c:ace (/ val_dxf remove-if getang ang->param ent lst ang1 ang2)

 ;; Retourne la valeur dxf de l'entité pour le code spécifié
 (defun val_dxf (code ent)
   (cdr (assoc code (entget ent)))
 )

 ;; Enlève les membres d'une liste répondant à une condition
 (defun remove-if (fun from)
   (cond
     ((atom from) from)
     ((apply fun (list (car from))) (remove-if fun (cdr from)))
     (t (cons (car from) (remove-if fun (cdr from))))
   )
 )

 ;; Saisie, par l'utilisateur, des angles de départ et de fin de l'arc
 (defun getang	()
   (initget 1)
   (setq ang1
   (getangle (trans (val_dxf 10 ent) ent 1)
	     "\nSpécifiez l'angle de départ de l'arc: "
   )
   )
   (initget 1)
   (setq ang2
   (getangle (trans (val_dxf 10 ent) ent 1)
	     "\nSpécifiez l'angle de fin de l'arc: "
   )
   )
   (foreach ang '(ang1 ang2)
     (set ang (+ (eval ang) (angle '(0 0) (getvar "UCSXDIR"))))
   )
 )

 ;; Convertit l'angle saisi en "paramètre" de l'ellipse (code dxf 41 et 42)
 (defun ang->param (ang)
   (setq ang (- ang (angle '(0 0) (trans (val_dxf 11 ent) 0 ent))))
   (atan (sin ang) (* (cos ang) (val_dxf 40 ent)))
 )

 ;; Fonction principale
 (if (and (= 1 (getvar "pickfirst"))
   (setq set1 (ssget "_i" '((0 . "ARC,CIRCLE,ELLIPSE"))))
   (eq 1 (sslength set1))
     )
   (progn
     (setq ent (ssname set1 0))
     (sssetfirst nil nil)
   )
   (progn
     (sssetfirst nil nil)
     (while (not
       (and
	 (setq ent
		(car (entsel
		       "\nSélectionnez un arc, un cercle, ou une ellipse: "
		     )
		)
	 )
	 (or
	   (= (val_dxf 0 ent) "ARC")
	   (= (val_dxf 0 ent) "CIRCLE")
	   (= (val_dxf 0 ent) "ELLIPSE")
	 )
       )
     )
     )
   )
 )
 (setq lst (entget ent))
 (if (not
(equal (mapcar '- (trans '(0 0 1) 1 0) (trans '(0 0 0) 1 0))
       (val_dxf 210 ent)
       1e-009
)
     )
   (princ
     "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles."
   )
   (cond
     ((= (val_dxf 0 ent) "ARC")
      (foreach	code '(-1 0 330 5 100 50 51)
 (setq lst (remove-if '(lambda (x) (= (car x) code)) lst))
      )
      (setq lst (cons '(0 . "CIRCLE") lst))
      (command "_regen")
      (entmake lst)
      (entdel ent)
     )
     ((= (val_dxf 0 ent) "CIRCLE")
      (getang)
      (foreach	code '(-1 0 330 5 100)
 (setq lst (remove-if '(lambda (x) (= (car x) code)) lst))
      )
      (setq lst
      (append (list '(0 . "ARC") (cons 50 ang1) (cons 51 ang2))
	      lst
      )
      )
      (command "_regen")
      (entmake lst)
      (entdel ent)
     )
     ((= (val_dxf 0 ent) "ELLIPSE")
      (cond
 ((and (= (val_dxf 41 ent) 0.0)
       (= (val_dxf 42 ent) (* 2 pi))
  )
  (getang)
  (foreach ang '(ang1 ang2)
    (set ang (ang->param (eval ang)))
  )
  (setq	lst (subst (cons 41 ang1) (assoc 41 lst) lst)
	lst (subst (cons 42 ang2) (assoc 42 lst) lst)
  )
  (command "_regen")
  (entmod lst)
  (entupd ent)
 )
 (T
  (setq	lst (subst '(41 . 0.0) (assoc 41 lst) lst)
	lst (subst (cons 42 (* 2 pi)) (assoc 42 lst) lst)
  )
  (command "_regen")
  (entmod lst)
  (entupd ent)
 )
      )
     )
   )
 )
 (princ)
)

Tous les commentaires sont, bien entendu, les bienvenus.

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

CDL · le 10 novembre 2005

Ma configuration :

AutoCAD LT 2002 +LT-EXTENDER

Pas de problèmes détectés ! :o

Suggestion :

Si les 2 axes d’une ellipse sont égaux possibilité de transformer en cercle.

Et pourquoi pas un cercle en ellipse. :cool:

Bon boulot :)

aplus

bonuscad · le 10 novembre 2005

Salut (gile).

Essayé sous 2000-2002 et 2005, pas de surprise, ça fonctionne nickel.

Bravo!

En cas de seuils multiples d'ajustement coupant plusieurs fois l'objet, ta commande peut remplacer avantageusement la commande "_trim".

Est tu sûr que la commande "_regen" soit indispensable dans ton code? Je dirais que non (pas d'entité complexe, ou d'imbrication), mais tu as peut être une bonne raison de l'avoir fait. ;)

Le gang des "Lispeurs" de CadXp s'étoffe. :D

@+

(gile) · le 10 novembre 2005

Salut,

Merci à vous pour les tests et les compliments :red:

Est tu sûr que la commande "_regen" soit indispensable dans ton code?

Comme expliqué ici, le (command "regen") est en fait un moyen que j'ai trouvé pour faire une sorte de marque pour la commande "_undo". Sans ce (command "regen") dans la routine, si on fait "annuler" ou "u" après l'exécution de la routine, çà annule la commande précédent le lancement de la routine (les fonctions entmake, entmod, entupd sont comme "transparentes" pour "_undo"). J'ai donc préféré cette solution à (command "_undo" "_begin") et (command "_undo" "_end").

Suggestion :
Si les 2 axes d’une ellipse sont égaux possibilité de transformer en cercle.
Et pourquoi pas un cercle en ellipse.

Je vais essayer de regarder, mais l'idéal serait quelque chose du genre" étirer" le cercle ou l'ellipse et un affichage dynamique avec (grread) et (grvecs), mais là, c'est plus le domaine du "grand" Bonuscad ;) .

À plus.

[Edité le 10/11/2005 par (gile)]

(gile) · le 11 novembre 2005

Voilà un premier jet de transformation de cercle en ellipse et vice-versa :

- Le 11/05/05 à 19h26 - Ajout d'un contrôle au cas où la première extrémité spécifiée pour une ellipse ne serait pas l'extrémité du grand axe et la possibilité de conserver ou d'effacer l'objet source.

-Le 12/11/05 à 10h13 - Ajout de la définition de (remove-if) et remplacement des (vl-remove-if) par (remove-if) pour la compatibilité avec les logiciels IntelliCAD, IntelliDESK...

- Le 27/11/05 - Correction des dysfonctionnements en 3D.

;;; C-E Convertit un cercle en ellipse ou vice-versa

(defun c:c-e (/ val_dxf remove-if set1 ent cen ext dist lst os resp)

 ;; Retourne la valeur dxf de l'entité pour le code spécifié
 (defun val_dxf (code ent)
   (cdr (assoc code (entget ent)))
 )

 ;; Enlève les membres d'une liste répondant à une condition
 (defun remove-if (fun from)
   (cond
     ((atom from) from)
     ((apply fun (list (car from))) (remove-if fun (cdr from)))
     (T (cons (car from) (remove-if fun (cdr from))))
   )
 )

 ;; Fonction principale
 (if (and (= 1 (getvar "pickfirst"))
   (setq set1 (ssget "_i" '((0 . "CIRCLE,ELLIPSE"))))
   (eq 1 (sslength set1))
     )
   (progn
     (setq ent (ssname set1 0))
     (sssetfirst nil nil)
   )
   (progn
     (sssetfirst nil nil)
     (while (not
       (and
	 (setq ent
		(car (entsel
		       "\nSélectionnez un cercle, ou une ellipse: "
		     )
		)
	 )
	 (or
	   (= (val_dxf 0 ent) "CIRCLE")
	   (= (val_dxf 0 ent) "ELLIPSE")
	 )
       )
     )
     )
   )
 )
 (setq	lst (entget ent)
cen (val_dxf 10 ent)
 )
 (if (equal (trans '(0 0 1) 1 0 T)
     (val_dxf 210 ent)
     1e-009
     )
   (progn
     (if (zerop (logand 16 (getvar "osmode")))
(progn
  (setq os (getvar "osmode"))
  (setvar "osmode" (+ os 16))
)
(setq os nil)
     )
     (cond
((= (val_dxf 0 ent) "CIRCLE")
 (setq cen  (trans cen ent 1)
       ext  (getpoint cen "\nSpécifiez l'extrémité du grand axe: ")
       dist (getdist cen
		     "\nSpécifiez la distance avec l'autre axe: "
	    )
       dist (/ dist (distance cen ext))
 )
 (if (	   (setq ext  (polar cen
		     (+ (/ pi 2) (angle cen ext))
		     (* dist (distance cen ext))
	      )
	 dist (/ 1 dist)
   )
 )
 (setq cen (trans cen 1 0)
       ext (mapcar '- (trans ext 1 0) cen)
 )
 (if (equal 1.0 dist 1e-009)
   (progn
     (initget "Cercle Ellipse")
     (setq resp
	    (getkword
	      "\nL'ellipse spécifiée est circulaire
		      \nConserver un cercle ou créer une ellipse [Cercle/Ellipse] ? : "
	    )
     )
   )
 )
 (cond
   ((= resp "Cercle")
    (setq lst
	   (subst (cons 40 (distance '(0 0) ext)) (assoc 40 lst) lst)
    )
    (command "_regen")
    (entmake lst)
   )
   (T
    (foreach code '(-1 0 330 5 10 100 40)
      (setq lst (remove-if '(lambda (x) (= (car x) code)) lst))
    )
    (setq lst
	   (append (list '(0 . "ELLIPSE")
			 '(100 . "AcDbEntity")
			 '(100 . "AcDbEllipse")
			 (cons 10 cen)
			 (cons 11 ext)
			 (cons 40 dist)
			 (cons 41 0.0)
			 (cons 42 (* 2 pi))
		   )
		   lst
	   )
    )
    (command "_regen")
    (entmake lst)
   )
 )
)
((= (val_dxf 0 ent) "ELLIPSE")
 (setq dist (getdist (trans cen 0 1) "\nSpécifiez le rayon: "))
 (foreach code '(-1 0 330 5 100 10 11 40 41 42)
   (setq lst (remove-if '(lambda (x) (= (car x) code)) lst))
 )
 (setq lst (append (list '(0 . "CIRCLE")
			 (cons 10 (trans cen 0 (trans '(0 0 1) 1 0 T)))
			 (cons 40 dist)
		   )
		   lst
	   )
 )
 (command "_regen")
 (entmake lst)
)
     )
     (initget "Oui Non")
     (if (/= (getkword "\nEffacer l'objet source ? [Oui/Non] : ")
      "Non"
  )
(entdel ent)
     )
     (if os
(setvar "osmode" os)
     )
   )
   (princ
     "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles."
   )
 )
 (princ)
)

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

[Edité le 27/11/2005 par (gile)]

(gile) · le 12 novembre 2005

Le même, avec des (command) à la place des (entmake) pour avoir l'affichage dynamique au moment du choix du rayon ou de la seconde extrémité :

- Le 27/11/05 - Correction des dysfonctionnements en 3D.

;;; C-E Convertit un cercle en ellipse ou vice-versa

(defun c:c-e (/ c-e_err val_dxf set1 ent lst cen os e_lst)

 ;; Redéfinition de *error*
 (defun C-E_ERR (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;; Retourne la valeur dxf de l'entité pour le code spécifié
 (defun val_dxf (code ent)
   (cdr (assoc code (entget ent)))
 )

 ;; Fonction principale
 (setq	m:err	*error*
*error*	c-e_err
 )
 (if (and (= 1 (getvar "pickfirst"))
   (setq set1 (ssget "_i" '((0 . "CIRCLE,ELLIPSE"))))
   (eq 1 (sslength set1))
     )
   (progn
     (setq ent (ssname set1 0))
     (sssetfirst nil nil)
   )
   (progn
     (sssetfirst nil nil)
     (while (not
       (and
	 (setq ent
		(car (entsel
		       "\nSélectionnez un cercle, ou une ellipse: "
		     )
		)
	 )
	 (or
	   (= (val_dxf 0 ent) "CIRCLE")
	   (= (val_dxf 0 ent) "ELLIPSE")
	 )
       )
     )
     )
   )
 )
 (setq	lst (entget ent)
cen (trans (val_dxf 10 ent) ent 1)
 )
 (if (equal (trans '(0 0 1) 1 0 T)
     (val_dxf 210 ent)
     1e-009
     )
   (progn
     (cond
((= (val_dxf 0 ent) "CIRCLE")
 (command "_ellipse" "_c" cen pause pause)
 (if
   (equal 1.0 (val_dxf 40 (entlast)) 1e-009)
    (progn
      (initget "Cercle Ellipse")
      (if
	(=
	  (getkword
	    "\nL'ellipse spécifiée est circulaire
          \nCréer un cercle ou une ellipse [Cercle/Ellipse] ? : "
	  )
	  "Cercle"
	)
	 (progn
	   (setq e_lst
		  (subst
		    (cons
		      40
		      (distance '(0 0) (val_dxf 11 (entlast)))
		    )
		    (assoc 40 lst)
		    lst
		  )
	   )
	   (entdel (entlast))
	   (entmake e_lst)
	 )
      )
    )
 )
)
((= (val_dxf 0 ent) "ELLIPSE")
 (command "_circle" cen pause)
)
     )
     (setq e_lst (entget (entlast)))
     (foreach code '(8 6 62 48)
(cond
  ((and (assoc code lst) (assoc code e_lst))
   (setq
     e_lst (subst (assoc code lst) (assoc code e_lst) e_lst)
   )
  )
  ((assoc code lst)
   (setq e_lst (append e_lst (list (assoc code lst))))
  )
)
(entmod e_lst)
(entupd (entlast))
     )
     (initget "Oui Non")
     (if (/= (getkword "\nEffacer l'objet source ? [Oui/Non] : ")
      "Non"
  )
(entdel ent)
     )
   )
   (princ
     "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles."
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 27/11/2005 par (gile)]

(gile) · le 13 novembre 2005

À propos du premier LISP :

En cas de seuils multiples d'ajustement coupant plusieurs fois l'objet, ta commande peut remplacer avantageusement la commande "_trim".

Il était donc dommage de se priver de la possibilité de simplement modifier le départ et/ou la fin d'un arc.

Il est toujours possible de transformer un arc en cercle ou en ellipse avec l'option "Fermer" et de tranformer un cercle ou une ellipse en arc.

Nouvelle version (25/11/05)

;;; ARCEDIT - Convertit un cercle ou une ellipse en arc ou modifie le départ et la fin
;;; d'un arc d'après les angles spécifiés, l'option "Fermer" permet la conversion d'un
;;; arc de cercle en cercle ou d'un arc elliptique en ellipse fermée.

(defun c:arcedit (/	    val_dxf   extr_dir	remove-if getang
	  ang->param	      set1	ent	  lst
	  ang1	    ang2      opt
	 )

 ;; Retourne la valeur dxf de l'entité pour le code spécifié
 (defun val_dxf (code ent)
   (cdr (assoc code (entget ent)))
 )

 ;; extr_dir Retourne la direction d'extrusion du SCU courant (vecteur)
 (defun extr_dir ()
   (trans '(0 0 1) 1 0 T)
 )

 ;; Enlève les membres d'une liste répondant à une condition
 (defun remove-if (fun from)
   (cond
     ((atom from) from)
     ((apply fun (list (car from))) (remove-if fun (cdr from)))
     (t (cons (car from) (remove-if fun (cdr from))))
   )
 )

 ;; Saisie des angles de départ et de fin de l'arc (option "Fermer")
 (defun getang	()
   (if	(or (= (val_dxf 0 ent) "CIRCLE")
    (and (= (val_dxf 0 ent) "ELLIPSE")
	 (= (val_dxf 41 ent) 0.0)
	 (= (val_dxf 42 ent) (* 2 pi))
    )
)
     (progn (setq opt "") (initget 1))
     (progn (setq opt " ou [Fermer]") (initget 1 "Fermer"))
   )
   (if	(numberp (setq ang1
		(getangle (trans (val_dxf 10 ent) ent 1)
			  (strcat "\nSpécifiez l'angle de départ de l'arc"
				  opt
				  ": "
			  )
		)
	 )
)
     (progn
(initget 1)
(setq ang2
       (getangle (trans (val_dxf 10 ent) ent 1)
		 "\nSpécifiez l'angle de fin de l'arc: "
       )
)
(foreach ang '(ang1 ang2)
  (set ang
       (+ (eval ang)
	  (angle '(0 0) (trans (getvar "UCSXDIR") 0 (extr_dir)))
	  (getvar "ANGBASE")
       )
  )
)
     )
   )
 )

 ;; Convertit l'angle saisi en "paramètre" de l'ellipse (code dxf 41 et 42)
 (defun ang->param (ang)
   (setq ang (- ang
	 (angle '(0 0) (trans (val_dxf 11 ent) 0 (extr_dir)))
      )
   )
   (atan (sin ang) (* (cos ang) (val_dxf 40 ent)))
 )

 ;; Fonction principale
 (if (and (= 1 (getvar "pickfirst"))
   (setq set1 (ssget "_i" '((0 . "ARC,CIRCLE,ELLIPSE"))))
   (eq 1 (sslength set1))
     )
   (progn
     (setq ent (ssname set1 0))
     (sssetfirst nil nil)
   )
   (progn
     (sssetfirst nil nil)
     (while (not
       (and
	 (setq ent
		(car (entsel
		       "\nSélectionnez un arc, un cercle, ou une ellipse: "
		     )
		)
	 )
	 (or
	   (= (val_dxf 0 ent) "ARC")
	   (= (val_dxf 0 ent) "CIRCLE")
	   (= (val_dxf 0 ent) "ELLIPSE")
	 )
       )
     )
     )
   )
 )
 (setq lst (entget ent))
 (if (equal (extr_dir)
     (val_dxf 210 ent)
     1e-009
     )
   (progn
     (getang)
     (cond
((= (val_dxf 0 ent) "ARC")
 (if (= ang1 "Fermer")
   (progn
     (foreach code '(-1 0 330 5 100 50 51)
       (setq
	 lst (remove-if '(lambda (x) (= (car x) code)) lst)
       )
     )
     (setq lst (cons '(0 . "CIRCLE") lst))
   )
   (setq lst (subst (cons 50 ang1) (assoc 50 lst) lst)
	 lst (subst (cons 51 ang2) (assoc 51 lst) lst)
   )
 )
)
((= (val_dxf 0 ent) "CIRCLE")
 (foreach code '(-1 0 330 5 100)
   (setq lst (remove-if '(lambda (x) (= (car x) code)) lst))
 )
 (setq lst
	(append	(list '(0 . "ARC") (cons 50 ang1) (cons 51 ang2))
		lst
	)
 )
)
((= (val_dxf 0 ent) "ELLIPSE")
 (if (= ang1 "Fermer")
   (setq ang1 0.0
	 ang2 (* 2 pi)
   )
   (foreach ang	'(ang1 ang2)
     (set ang (ang->param (eval ang)))
   )
 )
 (setq lst (subst (cons 41 ang1) (assoc 41 lst) lst)
       lst (subst (cons 42 ang2) (assoc 42 lst) lst)
 )
)
     )
     (command "_regen")
     (entmake lst)
     (entdel ent)
   )
   (princ
     "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles."
   )
 )
 (princ)
)

[Edité le 13/11/2005 par (gile)][Edité le 20/11/2005 par (gile)]

[Edité le 25/11/2005 par (gile)]

(gile) · le 20 novembre 2005

Suite à cette discussion j'ai modifier le dernier LISP (le plus abouti) pour y intégrer la gestion de ANGBASE.

(gile) · le 24 novembre 2005

Les dysfonctionnements en 3D (SCU non paralèlles au SCG) sont maintenant résolus (enfin je pense...)

Connexion

Cercles ou Ellipse -> Arcs & vice-versa

Messages recommandés

(gile)

CDL

bonuscad

(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