Centre de gravité

[Matt666]

Bonjour !!

 

Je sais que ce sujet a déjà été traité dans ce forum. Ce message s'adresse à ceux qui utilisent un moteur IntelliCAD (donc sous BricsCAD et consorts), bref ceux qui ne peuvent pas (encore ?) utiliser de VLISP. Voici une routine permettant de trouver approximativement le centre de gravité d'une polyligne. Elle a été créée ici , par bonuscad, à ce que je comprends.

 

 

PT_GRAVITY

;;; twice the area of a simple 2d triangle
;;; z ignored
(defun GEOM-AREA2 (a b c)
    (- 
         (* 
              (- (car b)(car a))
              (- (cadr c)(cadr a))
         )
         (* (- (car c)(car a))
         (- (cadr b)(cadr a)))
    )
)


;;; three times the centroid of a simple 2d triangle,
;;; z ignored, 2d point returned
(defun GEOM-CENTROID2Dx3 (pts)
    (list 
         (apply '+ (mapcar 'car pts))
         (apply '+ (mapcar 'cadr pts))
    )
)

;;; Computes the centroid (center of gravity) of an arbitrary
;;; simple polygon via a weighted sum of signed triangle areas,
;;; weighted by the centroid of each triangle.
;;; Thanks to Kamal Boutora
;;; Returns 3D-point, accepts only 2d or 3d points
;;; Twice area and three times centroid is used to avoid division
;;; until the last moment. see comp.graphics.algorithms FAQ or
;;; the O'Rourke code centroid.c
(defun GEOM-CENTROID2D (pts / areasum2 a2 p0 c3 cg)
    (setq 
         areasum2 0.0
         cg '(0 0)
         p0 (car pts)
         pts (cdr pts)
    )
    (if (equal p0 (last pts)) (setq pts (reverse (cdr (reverse pts)))))
    (while (cadr pts)
         (setq 
              c3 (geom-centroid2dx3 (list p0 (car pts) (cadr pts)))
              a2 (geom-area2 p0 (car pts) (cadr pts))
              cg (list (+ (car cg) (* a2 (car c3)))
              (+ (cadr cg) (* a2 (cadr c3))))
              areasum2 (+ areasum2 a2)
              pts (cdr pts)
         )
    )
    (setq areasum2 (* areasum2 3.0))
    (if (caddr p0)
         (list (/ (car cg) areasum2)(/ (cadr cg) areasum2)(caddr p0))
         (list (/ (car cg) areasum2)(/ (cadr cg) areasum2))
    )
)
(defun C:pt_gravity ( / ent pt_lst pt_ucs)
    (while (not ent)
         (setq ent (entsel "\nSélectionner une Polyligne:"))
         (if ent
              (progn
                   (setq ent (entget(car ent)))
                   (if (/= (cdr(assoc 0 ent)) "LWPOLYLINE")
                        (progn
                             (prompt "\nEntitée sélectionnée n'est pas une Polyligne optimisée. Réessayer")
                             (setq ent nil)
                        )
                   )
              )
              (prompt "\nAucune sélection. Réessayer")
         )
    )
    (setq pt_lst (mapcar '(lambda (x) (trans x 0 1)) (mapcar 'cdr (remove-if-not '(lambda (x) (= (car x) 10)) ent))))
    (command "_.point" "_none" (GEOM-CENTROID2D pt_lst))
    (princ)
)

Cette routine ne donne pas directement le centre mais génère un point représentant celui-ci. Il faut cliquer sur la poyligne.

 

Pour avoir seulement les coordonnées de la polyligne, et ce sans la sélectionner mais en donnant seulement son ENAME, il faut juste changer le code de la fonction principale, à la fin :

 
(defun pt_gravity (ent / pt_lst)
    (if (and 
              (eq (type ent) 'ename)
              (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
         )
         (progn
              (setq 
                   ent (entget ent)
                   pt_lst (mapcar '(lambda (x) (trans x 0 1)) (mapcar 'cdr (remove-if-not '(lambda (x) (= (car x) 10)) ent)))
              )
              (GEOM-CENTROID2D pt_lst)
         )
    )
)

L'argument ENT demande le nom d'une polyligne ('ENAME) que l'on peut trouver en exécutant un petit (car (entsel)) sur une polyligne.

 

Au passage, un petit exemple de la puissance du LISP avec cette fonction plutot pas mal, que je n'ai jamais pu trouver malgré le temps passé à chercher :

(mapcar 'cdr (remove-if-not '(lambda (x) (= (car x) 10)) ent))

qui retourne tous les elts de la liste commençant par 10...

 

PS : Pour que cette routine fonctionne, il faut aussi la routine de Gile remove-if-not, qu'on peut trouver ici ... Ceux qui n'ont pas le VLISP feraient mieux de très vite lancer toutes ces routines à chaque démarrage, elles sont vraiment très pratiques... :D

 

Voilà !

A bientot.

Matt.

[Matt666]

Donc pour lancer la commande, il faut entrer dans la ligne de commande :

(pt_gravity (car (entsel)))

(Pour ceux qui n'auraient pas bien compris ;) )

 

A bientot !

Matt.

 

PS : Que ceux qui voient un moyen de raccourcir ce LISP n'hésitent surtout pas !!

 

[bonuscad]

Elle a été créée ici , par bonuscad, à ce que je comprends.

 

Nenni, je n'en suis pas l'auteur! J'aurais bien voulu :P

 

Je crois que c'est Reini Urban amélioré par des remarques de Kamal Boutora.

 

Kamal confirmera peut être... car je n'ai pas retrouvé de liens (qui sont anciens).

[Matt666]

Une autre, nettement plus simple, mais encore moins précise !!!

 

(defun gravite (ent / pts)
    (if ent (setq pts (mapcar 'cdr (remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))))
    (if pts
         (List
              (/ (apply '+ (mapcar 'car pts)) (length pts))
              (/ (apply '+ (mapcar 'cadr pts)) (length pts))
              0.000
         )
    )
)

 

A bientot.

Matt.

 

[Edité le 10/9/2007 par Matt666]

[(gile)]

Salut,

 

Je n'ai pas décortiqué la première routine, mais son principe :

- diviser le polygone (polyligne sans arcs) en triangles,

- calculer le centre de gravité de chaque triangle et sa surface

- faire la somme des centres pondérés par leurs surface

est un méthode mathématiquement "juste" pour trouver le centre de gravité. J'explquais cette méthode ici en la différenciant de la méthode qui calcule l'équibarycentre de plusieurs points (la moyenne de la somme des points) qui est celle utilisée par le second LISP.

[(gile)]

À y regarder de plus près, l'algorythme de premier LISP n'est pas celui que je décris, mais un beaucoup plus simple qui consiste à ajouter les centres de gravités des triangles constitués par le premier sommet et 2 sommets successifs suivants (p0 p1 p2 puis p0 p2 p3 puis p0 p3 p4 etc..) chaque point étant pondéré par la "surface geométrique" du triangle (cette surface est négative si les points tournent dans le sens horaire, positive sinon).

 

Des explications plus précises (mais en anglais) ici au chapitre 2.2 : Subject 2.02: How can the centroid of a polygon be computed?

 

Merci beaucoup matt666 pour avoir déniché ce LISP qui m'en a appris une bien bonne :D

[Matt666]

oulah mais c'est le monde à l'envers !!!! :laugh:

 

Et il est humble en plus de ça !!

 

Surtout, Gile, DE RIEN, vu le nombre de précieux conseils et coups de main que tu as donné à bon nombre de gens, et à moi en particulier....

 

Ça me fait plaisir de pouvoir te rendre une infime part de ce que tu donnes tous les jours !

 

Au passage dès que je trouve des routines autoLISP "traduites" du VLISP, j'essaierai de les mettre ici...

 

A bientot !

Matt.

[(gile)]

Comme l'algorythme me plaisait bien (sacré Reini Urban si c'est bien lui) je me suis amusé à compléter la routine pour qu'elle fonctionne aussi avec les polylignes contenant des arcs.

 

Voici un premier jet qui semble bien marcher (les résultats sont les mêmes qu'avec une région ayant le même contour) mais je continuerai d'essayer d'optimiser, notament le calcul du centre de gravité des portions de disques dans les polyarcs (voir ce sujet).

 

EDIT : Merci à lili2006 pour la formule permettant de situer le centre de gravité d'une portion de disque.

 

EDIT : VERSION FINALE (?)

 

;; ALGEB-AREA
;; Retourne l'aire algébrique du triangle défini par 3 points 2D
;; l'aire est négative si les points sont en sens horaire

(defun algeb-area (p1 p2 p3)
 (/ (-	(* (- (car p2) (car p1))
   (- (cadr p3) (cadr p1))
)
(* (- (car p3) (car p1))
   (- (cadr p2) (cadr p1))
)
    )
    2.0
 )
)

;; TRIANGLE-CENTROID
;; Retourne le centre de gravité d'un trinagle défini par 3 points

(defun triangle-centroid (p1 p2 p3)
 (mapcar '(lambda (x1 x2 x3)
     (/ (+ x1 x2 x3) 3.0)
   )
  p1
  p2
  p3
 )
)

;; POLYARC-CENTROID
;; Retourne une liste dont le premier élément est le centre de gravité du polyarc
;; et le second son aire algébrique (négative si la courbure est en sens horaire)
;;
;; Arguments
;; bu : la courbure du polyarc (bulge)
;; p1 : le sommet de départ
;; p2 : le sommet de fin

(defun polyarc-centroid	(bu p1 p2 / ang rad cen area dist cg)
 (setq	ang  (* 2 (atan bu))
rad  (/	(distance p1 p2)
	(* 2 (sin ang))
     )
cen  (polar p1
	    (+ (angle p1 p2) (- (/ pi 2) ang))
	    rad
     )
area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
dist (/ (expt (distance p1 p2) 3) (* 12 area))
cg   (polar cen
	    (- (angle p1 p2) (/ pi 2))
	    dist
     )
 )
 (list cg area)
)

;; PLINE-CENTROID
;; Retourne le centre de gravité d'une polyligne (coordonnées SCG)
;;
;; Argument
;; pl : nom d'entité de la polyligne (ename)

(defun pline-centroid (pl / elst lst tot cen p0 p-c cen area)
 (setq elst (entget pl))
 (while (setq elst (member (assoc 10 elst) elst))
   (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
  elst (cdr elst)
   )
 )
 (setq	lst (reverse lst)
tot 0.0
cen '(0.0 0.0)
p0  (caar lst)
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
  tot (cadr p-c)
   )
 )
 (setq lst (cdr lst))
 (if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
 )
 (while (cadr lst)
   (setq area (algeb-area p0 (caar lst) (caadr lst))
  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
	       cen
	       (triangle-centroid p0 (caar lst) (caadr lst))
       )
  tot  (+ area tot)
   )
   (if	(/= 0 (cdar lst))
     (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))
    cen	(mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
		cen
		(car p-c)
	)
    tot	(+ tot (cadr p-c))
     )
   )
   (setq lst (cdr lst))
 )
 (if (/= 0 (cdar lst))
   (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
  cen (mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
		cen
		(car p-c)
	)
  tot (+ tot (cadr p-c))
   )
 )
 (trans (list (/ (car cen) tot)
       (/ (cadr cen) tot)
       (cdr (assoc 38 (entget pl)))
 )
 pl
 0
 )
)

 

Un exemple d'utilisation :

 

;; PT-CEN
;; Crée un objet point sur centre de gravité de la polyligne sélectionnée

(defun c:pt-cen	(/ ent elst elv)
 (and
   (setq ent (car (entsel)))
   (setq elst (entget ent))
   (setq elv (cdr (assoc 38 elst)))
   (= "LWPOLYLINE" (cdr (assoc 0 elst)))
   (entmake
     (list '(0 . "POINT") (cons 10 (pline-centroid ent)))
   )
 )
 (princ)
) 

[Edité le 13/9/2007 par (gile)][Edité le 14/9/2007 par (gile)]

[Edité le 15/9/2007 par (gile)]

[(gile)]

J'ai modifié la routine ci-dessus : l'argument pour PLINE-CENTROID est désormais le nom d'entité (ename) de la polyligne, ce qui devrait être plus pratique à l'usage.

 

Par alleurs, d'après les tests que j'ai fait, cette routine, bien que beaucoup moins concise, s'exécute plus de 3 fois plus vite que celle qui, en Visual LISP, consisterait à créer une région (vla-object), récupérer son 'Centroid' et la supprimer, (ceci est certainement dû à l'utilisation du modeleur pour créer la region).

 

(defun vl-pline-centroid (pl / AcDoc Space obj reg cen)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (or (= (type pl) 'VLA-OBJECT)
     (setq obj (vlax-ename->vla-object pl))
 )
 (setq	reg (vlax-invoke Space 'addRegion (list obj))
cen (vlax-get (car reg) 'Centroid)
 )
 (vla-delete (car reg))
 (trans cen 1 (vlax-get obj 'Normal))
) 

[Matt666]

"ceinture rouge et blanche 6em dan"

 

Si c'est pas la classe ça !!! Bravo !

 

Merci d'avoir créé une routine en autolisp et en Vlisp, pour ceux qui n'ont pas la chance de pouvoir utiliser le VLisp....

 

Je suis quand même sacrément bluffé par ta maîtrise du Lisp, c'est impressionant...

 

Et je rejoins ce que dit lili2006 à propos de ce site

Je pense qu'en 1 an sur ce sîte, j'en ai appris plus sur AutoCAD qu'en 15 ans d'utilisation

 

Abientot !

Matt.

[(gile)]

"ceinture rouge et blanche 6em dan"

Je n'avais pas remarqué, mais c'est juste une quetion de "tchatche" (3000 messages).

 

Merci d'avoir créé une routine en autolisp et en Vlisp, pour ceux qui n'ont pas la chance de pouvoir utiliser le VLisp....

Dans le cas présent, je conseillerais à ceux qui peuvent utiliser le vlisp d'utiliser quand même cette routine, elle est plus de 3 fois plus rapide que celle en vlisp et, d'après mes tests, plus fiable en 3d (SCU non parallèle au SCG).

 

J'ai apporté quelques petites améliorations à la routine, pour un usage plus "universel", le centre de gravité est désormais retourné en coordonnées SCG.

 

[Edité le 15/9/2007 par (gile)]

[willy95]

Bonjour,

 

Bien que pour certains c'est encore un retour dans le passé , j'adore cette histoire de centre de gravité :wub: , à tel point que j'essai de l'intégrer dans certains de mes codes, j'ai en partie réussi mais une question reste sans réponse malgré mon acharnement à vouloir l'adapter.

 

En fait je pose déjà la question de la sélection de la polyligne pour d'autre besoins et j'aimerai que "pt-cen" ne me redemande pas l'objet et qu'il utilise "Sel1" comme selection. Mais comment modifier cette variable "pl" en "Sel1" ?? :wacko:

 

Précédemment dans mon code :

(SetQ sel1 (EntSel "\nSelectionnez le périmètre: ")) 

 

Merci pour vos réponses qui j'espère m'inspirerons encore...

[VDH-Bruno]

Bonjour,

 

La ligne suivante avec entsel te retourne une liste composé du nom d'entité séléctionné et du point de sélection:

Commande: (SetQ sel1 (EntSel "\nSelectionnez le périmètre: "))

Selectionnez le périmètre: (<Nom d'entité: 7efb10c0> (-13294.9 4626.14 0.0))

 

La routine de (gile) pline-centroid demande de nom d'entité qu'il faut extraire de sel1 au moyen de la fonction car

Commande: (car sel1)

<Nom d'entité: 7efb10c0>

La bonne syntaxe devrait être:

 (pline-centroid (car sel1))

A+

[willy95]

Super c'est nickel grâce à l'intégration du code de Gile et à la précision de Bruno mon bout de code va me simplifier la vie ;)

 

Merci pour cette réponse réactive :D