Classement

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)]