Centre de gravité

[gile]

Salut,

 

voilà une routine qui permet de créer un point sur le centre de gravité d'une structure composée de solides de différentes densités, çà marche aussi en 2D avec des régions (section d'une structure linéaire).

 

Je ne sais pas si j'enfonce des portes ouvertes, mais le plaisir d'avoir appris me donne envie de partager.

 

;;; C:CENTROID Crée un point sur le centre de gravité d'une structure composée de solides de densités
;;; différentes (ou d'une section composée de régions) et affiche la masse totale de la structure
;;;
;;; L'utlisateur sélectionne les solides (ou les régions) un par un et, pour chaque solide (ou région),
;;; spécifie sa densité (ou annule la dernière sélection) puis entre "t" pour terminer la commande.

(defun C:CENTROID (/ obj mas cen vol den_prec den lst pts pt)
 (vl-load-com)
 (initget 1)
 (setq obj (entsel "\nSélectionnez un solide ou une région: "))
 (cond
   ((= (getval 0 obj) "3DSOLID")
    (setq mas T)
    (OBJ->BARYLST 'volume)
    (while (progn
      (initget 1 "Terminer")
      (not
	(= (setq obj (entsel "\nSélectionnez un solide ou [Terminer]: "))
	   "Terminer"
	)
      )
    )
      (if (= (getval 0 obj) "3DSOLID")
 (OBJ->BARYLST 'volume)
 (princ "\nEntité non valide.")
      )
    )
   )
   ((= (getval 0 obj) "REGION")
    (OBJ->BARYLST 'area)
    (while (progn
      (initget 1 "Terminer")
      (not
	(= (setq obj (entsel "\nSélectionnez une région ou [Terminer]: "))
	   "Terminer"
	)
      )
    )
      (if (= (getval 0 obj) "REGION")
 (OBJ->BARYLST 'area)
 (princ "\nEntité non valide.")
      )
    )
   )
   (T (princ "\nEntité non valide."))
 )
 (setq lst (BARYCENTRE (REMOVE_DOUBLES lst)))
 (mapcar 'vla-erase pts)
 (vla-addPoint
   (vla-get-ModelSpace
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (vlax-3D-point (car lst))
 )
 (if mas
   (princ (strcat "\nMasse totale : " (rtos (cdr lst))))
 )
 (princ)
)

;;; OBJ->BARYLST Crée une liste d'association contenant le centre de gravité et la masse
;;; de chaque solides ou régions

(defun OBJ->BARYLST (prop)
 (setq	obj (vlax-ename->vla-object (car obj))
cen (vlax-safearray->list
      (vlax-variant-value (vla-get-centroid obj))
    )
vol (* (vlax-get-property obj prop) 1e-6)
 )
 [surligneur](if (= (vla-get-ObjectName obj) "AcDbRegion")
   (setq cen (trans cen 1 0))  
 )[/surligneur]
 (vlax-invoke-method obj 'highlight 1)
 (if (not den_prec)
   (setq den_prec 1.0)
 )
 (initget "annUler")
 (setq	den (getreal
      (strcat "\nSpécifiez la densité du matériau ou [annUler] <"
	      (rtos den_prec)
	      ">: "
      )
    )
 )
 (if (= den "annUler")
   (vlax-invoke-method obj 'highlight 0)
   (progn
     (if den
(setq den_prec den)
(setq den den_prec)
     )
     (setq lst	(cons (cons cen (* vol den)) lst)
    pt	(vla-addPoint
	  (vla-get-ModelSpace
	    (vla-get-ActiveDocument (vlax-get-acad-object))
	  )
	  (vlax-3D-point cen)
	)
    pts	(cons pt pts)
     )
     (vlax-invoke-method obj 'highlight 0)
   )
 )
)

;;; BARYCENTRE Calcule le barycentre de points pondérés contenus dans une liste d'association
;;; ex : (BARYCENTRE '(((10.0 10.0 0.0) . 1.0) ((20.0 30.0 10.0) . 3.0))) -> (((17.5 25.0 7.5) . 4.0))

(defun BARYCENTRE (lst)
 (cond
   ((null (cdr lst)) (car lst))
   (T
    (BARYCENTRE
      (cons
 (cons
   (mapcar '+
	   (caar lst)
	   (mapcar '(lambda (x)
		      (* x (/ (cdadr lst) (+ (cdar lst) (cdadr lst))))
		    )
		   (mapcar '- (caadr lst) (caar lst))
	   )
   )
   (+ (cdar lst) (cdadr lst))
 )
 (cdr (cdr lst))
      )
    )
   )
 )
)

;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste

(defun REMOVE_DOUBLES (lst)
 (cond
   ((null lst) nil)
   (T
    (cons (car lst) (REMOVE_DOUBLES (vl-remove (car lst) lst)))
   )
 )
)

;;; GETVAL (Reini Urban) Retourne la première valeur du groupe d'une entité.
;;; Accepte tous les genres de représentations de l'entité
;;; (ename, les listes entget, les listes entsel)
;;; NOTE: Ne peut obtenir que le premier groupe 10 dans LWPOLYLINE !

(defun getval (grp ele)					    ; "valeur dxf" de toute entité.
 (cond
   ((= (type ele) 'ENAME)				    ; ENAME
    (cdr (assoc grp (entget ele)))
   )
   ((not (vl-consp ele)) nil)				    ; élément invalide
   ((= (type (car ele)) 'ENAME)			    ; liste entsel
    (cdr (assoc grp (entget (car ele))))
   )
   (T (cdr (assoc grp ele)))				    ; liste entget
 )
)

 

Tous les commentaires sont évidemmment les bienvenus, à plus.[Edité le 23/5/2005 par gile][Edité le 23/5/2005 par gile]

 

[Edité le 9/6/2005 par gile]

[bonuscad]

Je ne veux pas te décourager, mais il y a beaucoup plus court.

 

La ligne de code n'est pas de moi, mais de notre ami Québécois Serge Camiré (le roi du code condensé au maximum;) ). Moi, je suis comme toi je découvre petit à petit "Visual Lisp" et "ActiveX"

 

Voici l'extrait essentiel de son code (car je ne sais plus où il l'avait publié, c'était en 2003) mais cette ligne te retourne le point de gravité dans le SCG.

 

(vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object (car (entsel))))))

 

Merci à Serge ! Je lui laisse le soin d'apporter des commentaires qui sont toujours très instructifs.

 

Un petit coup pub pour lui

MVPORT

[Tramber]

(vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))

est plus court mais pas beaucoup plus court ! :

 

(vlax-safearray->list(vlax-variant-value (vlax-get-property obj 'centroid)))

 

;)

[gile]

Merci pour les commentaires, çà ne me décourage pas bien au contraire !

 

Je vais éditer le code ci-dessus pour y introduire cette modification et corriger une petite erreur concernant l'affichage de la masse totale.

 

Mais comme le dit Tramber çà ne va pas beaucoup raccourcir le tout !

[gile]

Encore une correction !

 

Je viens de m'apercevoir que "vla-get-centroid" retourne les coordonnées du centre de gravité d'une région dans le SCU alors qu'il retourne celles d'un solide dans le SCG !

 

J'ai [surligneur]corrigé[/surligneur] le code ci-dessus en conséquence et j'en ai profité pour l'améliorer un peu (mise en sur brillance de l'objet sélectionné).

 

A plus.

 

[Edité le 10/6/2005 par gile]

[Serge]

gile,

 

On peut utiliser les conversions d'espace via trans.

 

Et comme le disait si bien Bonuscad, ceci retourne le centroïde en terme de WCS (SCG)

 

(trans (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object (car (entsel)))))) 1 0)

 

 

Et je ne cherche pas toujours à réduire le nombre de lignes de code, ça dépend du contexte :-))

L'instruction ci-haut planterait si on ne choisit rien ou si c'est un objet incompatible.

 

Serge

 

[gile]

Merci Serge,

 

J'apprécie beaucoup la concision et je suis sensible au "style" d'un code lisp, mais mon propos ici est de fournir une fonction qui ressemblerait à une fonction AutoCAD et qui ne planterait pas en cas de fausse manoeuvre de l'utilisateur.

 

Le but étant de placer un point un point sur le centre de gravité d'un ensemble d'objets pouvant avoir des densités différentes, je suis bien obligé de décomposer le code que tu propose pour faire des tests conditionnels sur la nature de l'objet (région, solide 3D ou autre)

pour permettre la sélection d'autres objets (de même nature que le premier) et l'indication pour chacun de sa densité.

Dans cet esprit, pour être complète, la fonction devrait aussi contenir une redéfinition de *errror* du style :

 

(defun CENTROID_ERR (msg)
 (if (or
(= msg "Fonction annulée")
(= msg "quitter / sortir abandon")
     )
   (princ)
   (princ (strcat "\nErreur: " msg))
 )
 (vla-endundomark
   (vla-get-activedocument (vlax-get-acad-object))
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
) 

et la constitution d'un groupe "undo" avec, au début de la définiton de C:CENTROID :

 

 (vla-startundomark
   (vla-get-activedocument (vlax-get-acad-object))
 )
 (setq	m:err	*error*
*error*	CENTROID_ERR
 )

et

 

 (vla-endundomark
   (vla-get-activedocument (vlax-get-acad-object))
 )
 (setq	*error*	m:err
m:err nil
 )

à la fin.

 

Merci encore, à plus

[Serge]

gile,

 

Mon style est très différent selon que ce soit

1) pour notre propre firme où là c'est blindé et largement documenté

2) pour un message s'adressant à un expert qui saura extraire les idées

3) pour un message s'adressant à un novice.

 

Par exemple, sur l'autre forum, quelqu'un demandait cette semaine de trouver les 2 foyers d'une ellipse. Tu pourras voir que le code est beaucoup plus explicite (code plus loin). J'utilise beaucoup la forme:

 

(cond

...(condition1)

...(condition2)

)

 

ou encore

 

(and

...(condition1)

...(condition2)

)

 

Voici le programme d'ellipse pour ceux que ça intéresse. Chaque étape du cond valide que l'on obtient de valeurs.

 

;;; FOYER - Indique les foyers d'une ellipse
;;; Par Serge Camiré, Cad-Novation. 2005-06-08
;;;
(defun c:foyer (
/ a angle1 angle2 b c centre ellipse ellipseGet ellipseSel foyer1 
  foyer2 major minor origine vaCentre vaMajor vaMinor vlaEllipse
  )
  (cond
     ((not (setq ellipseSel (entsel "\nMontez une ellipse: "))) nil)
     ((not (setq ellipseGet (entget (setq ellipse (car ellipseSel))))) nil)
     ((/= "ELLIPSE" (cdr (assoc 0 ellipseGet))) nil)
     (t
        (setq vlaEllipse (vlax-ename->vla-object ellipse))
        (setq vaCentre (vla-get-Center vlaEllipse))
        (setq vaMajor (vla-get-MajorAxis vlaEllipse))
        (setq vaMinor (vla-get-MinorAxis vlaEllipse))
        (setq centre (safearray-value (variant-value vaCentre)))
        (setq major (safearray-value (variant-value vaMajor)))
        (setq minor (safearray-value (variant-value vaMinor)))
        (setq origine '(0.0 0.0 0.0))
        (setq a (distance origine major))
        (setq b (distance origine minor))
        (setq c (sqrt (- (* a a) (* b b))))
        (setq angle1 (angle origine major))
        (setq angle2 (+ angle1 pi))
        (setq foyer1 (polar centre angle1 c))
        (setq foyer2 (polar centre angle2 c))
        (princ "\nFoyer 1 : ") (princ foyer1)
        (princ "\nFoyer 2 : ") (princ foyer2)
     )
  )
  (princ)
)

(princ "\nTapez FOYER pour connaitre les foyers d'une ellipse")
(princ "\nPourquoi ne pas essayer un MVPort dans l'intimité de votre foyer.")
(princ)

 

 

Ça aurait aussi pu s'écrire:

 

(defun c:foyer (
/ a angle1 angle2 b c centre ellipse ellipseGet ellipseSel foyer1 
  foyer2 major minor origine vaCentre vaMajor vaMinor vlaEllipse
  )
  (and
     (setq ellipseSel (entsel "\nMontez une ellipse: "))
     (setq ellipseGet (entget (setq ellipse (car ellipseSel))))
     (= "ELLIPSE" (cdr (assoc 0 ellipseGet)))
     (setq vlaEllipse (vlax-ename->vla-object ellipse))
     (setq vaCentre (vla-get-Center vlaEllipse))
     (setq vaMajor (vla-get-MajorAxis vlaEllipse))
     (setq vaMinor (vla-get-MinorAxis vlaEllipse))
     (setq centre (safearray-value (variant-value vaCentre)))
     (setq major (safearray-value (variant-value vaMajor)))
     (setq minor (safearray-value (variant-value vaMinor)))
     (setq origine '(0.0 0.0 0.0))
     (setq a (distance origine major))
     (setq b (distance origine minor))
     (setq c (sqrt (- (* a a) (* b b))))
     (setq angle1 (angle origine major))
     (setq angle2 (+ angle1 pi))
     (setq foyer1 (polar centre angle1 c))
     (setq foyer2 (polar centre angle2 c))
  )
  (if foyer2
  (progn
     (princ "\nFoyer 1 : ") (princ foyer1)
     (princ "\nFoyer 2 : ") (princ foyer2)
  ))
  (princ)
)

 

L'avantage du Cond est de pouvoir envoyer des messages explicites aux bons endroits.

 

Serge

 

 

[gile]

Serge,

 

Je viens seulement de voir ta réponse.

Il me semble que nous sommes d'accord quand à l'utilisation de différents styles suivant les circonstances.

Je voulais livrer, dans ce forum (routines LISP), le résultat de ce que m'avait apporté l'aide fournie dans un autre forum (Débuter en LISP) sous une forme directement utilisable.

Je pense que ce programme peut être utile à d'autre (il l'est pour moi), mais peut être que tous les "vieux Autocadiens" ont déjà quelque chose de similaire dans leur caisse à outils.

 

En tous cas, merci encore.

 

Aplus.

[mimine]

Re-bonjour Gile, j'ai un fichier avec beaucoup de rectangle.Mon but est d'insérer au centroid de chaque rectangle un bloc attribut ou un point, puis avec ton autre lisp "incss" (qui fonctionne à merveille) attribuer un increment à chaque bloc.

Je pourrais m'en sortir avec ton lisp "centroid" mais j'ai toujours le même problème, j'ai beaucoup de rectangle à traiter (3000).

Est il possible d'améliorer le lisp en selectionnant tous mon dessin?

 

Je te remercie d'avance