Récupérer coordonnées centre pt

[jeanmi66]

Bonjour,

 

j'ai récupéré sur ce même site une petite routine qui donne le centre de gravité d'une polyligne. Quand on clique la polyligne, un message apparait donnant ces coordonnées. Serait-il possible de lier cette routine à une fonction DEPLACER, ROTATION ou début d'une POLYLIGNE 2D ?

 

Si oui, voyez-vous comment faire, moi j'y connais rien en LISP !?

 

Voici la routine en question... Merci...

 

;;================================================================;;

;;; Donne le centre de gravité d'une polyligne

 

(defun C:GP ( / pol cdg)

(setq pol (car (entsel "\n pointez une polyligne")))

(if (setq cdg (cdgpol pol))

(alert (strcat "centre de gravité : " (rtos (car cdg) 2 3) " , " (rtos (cadr cdg) 2 3)))

)

)

 

(defun gp (pol / ent lp)

(if (and pol (= "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget pol))))))

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

(print "pas une polyligne !!! ")

)

(if lp

(List

(/ (apply '+ (mapcar 'car lp)) (length lp))

(/ (apply '+ (mapcar 'cadr lp)) (length lp))

)

)

)

[jeanmi66]

Heuu, je crois qu'il y a une erreur dans la routine... voici celle qui marche...

;;================================================================;;

;;; Donne le centre de gravité d'une polyligne

 

(defun C:GP ( / pol cdg)

(setq pol (car (entsel "\n pointez une polyligne")))

(if (setq cdg (gp pol))

(alert (strcat "centre de gravité : " (rtos (car cdg) 2 3) " , " (rtos (cadr cdg) 2 3)))

)

)

 

(defun gp (pol / ent lp)

(if (and pol (= "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget pol))))))

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

(print "pas une polyligne !!! ")

)

(if lp

(List

(/ (apply '+ (mapcar 'car lp)) (length lp))

(/ (apply '+ (mapcar 'cadr lp)) (length lp))

)

)

)

[bonuscad]

Si ta routine est chargée en mémoire tu peux utiliser la fonction (gp argument)

 

Exemple

((lambda ( / js ent key)
(while (null (setq js (ssget "_:S" '((0 . "LWPOLYLINE"))))))
(if js
	(progn
		(setq ent (ssname js 0))
		(initget "Deplacer Rotation Polyligne")
		(setq key (getkword "\n[Deplacer/Rotation/Polyligne]< Deplacer >: ")) 
		(cond
			((eq key "Polyligne") (command "_.pline" "_none" (gp ent) (while (not (zerop (getvar "cmdactive"))) (command pause))))
			((eq key "Rotation") (command "_.rotate" ent "" (gp ent) pause))
			(T (command "_move" ent "" (gp ent) pause))
		)
	)
)
))

[Patrick_35]

Salut

 

Ou encore avec ceci, qui utilise le lisp gp

(defun pgp(/ pol)
 (if (setq pol (car (entsel "\n pointez une polyligne ")))
   (gp pol)
 )
)

 

Lors de la demande du point de base ou du deuxième point, tu fais sur la ligne de commande (pgp)

exemple :

Commande: dp DEPLACER

Choix des objets: 1 trouvé(s)

 

Choix des objets:

 

Spécifiez le point de base ou [Déplacement] : (pgp)

 

pointez une polyligne(849.502 67.8645)

Spécifiez le deuxième point ou :

Commande:

 

@+

[jeanmi66]

BONUSCAD, je ne comprend pas comment faire fonctionner ta routine. Je l'ai rajouté à la suite de mon lisp qui contient plein d'autres routines.

 

Comment faire ensuite ?

[(gile)]

Salut jeanmi66,

 

Au risque de paraîte rabat-joie et pontilleux, je refais à nouveau cette remarque : la routine gp retourne l'équibarycentre de la polyligne. Ce point ne correspond au centre de gravité que pour certains polygones (triangles, carrés, rectangles, parallélogrames et les autres polygones réguliers) voir plus d'explications ici.

J'ai fait une routine qui retourne le centre de gravité de n'importe quelle polyligne, même avec des arcs : pline-centroid.

 

Tu peux l'utiliser comme le propose Partick_35, en remplaçant gp par pline-centroid dans la routine pgp.

 

[Edité le 6/2/2008 par (gile)]

[jeanmi66]

Merci Gile ! Je trouve ça très important, tu as raison de le notifier !!!!!!! Merci pour ta routine de centroïd, je vais la mettre en place !!!!!

 

:D

[jeanmi66]

Petit soucis Gile, j'arrive pas à organiser ta routine:

 

Je prends la grosse routine de ton message sur lequel tu renvoi, le 13/09 à 00:27. Ensuite, tu a écris l'exemple avec PT-CEN.

 

Mais ton message suivant le même jour à 09:46, tu ré-écris une petite routine qui, je pense, vient remplacer toute la partie PLINE-CENTROID de la grosse routine, c'est à dire jusqu'à la fin de celle-ci.

 

Ensuite, on peut ré-utiliser le même PT-CEN pour appeler tout ça.

 

J'ai bon là, ou je suis dans la gadoue ??? :exclam: Parceque là, ça marche pas !!!

 

Merci

 

[Edité le 6/2/2008 par jeanmi66]

[bonuscad]

C'est (lambda) qui te gène, c'était juste pour faire un test avec un copier-coller en ligne de commande.

 

Autrement on peut faire pareil avec la fonction de (gile). Tu peut mettre le nom de fonction que tu veux après (defun c:

 

(defun c:Mov_rotat-centroid ( / js ent key)
(while (null (setq js (ssget "_:S" '((0 . "LWPOLYLINE"))))))
(if js
(progn
(setq ent (ssname js 0))
(initget "Deplacer Rotation Polyligne")
(setq key (getkword "\n[Deplacer/Rotation/Polyligne]< Deplacer >: "))
(cond
((eq key "Polyligne") (command "_.pline" "_none" (pline-centroid ent) (while (not (zerop (getvar "cmdactive"))) (command pause))))
((eq key "Rotation") (command "_.rotate" ent "" (pline-centroid ent) pause))
(T (command "_move" ent "" (pline-centroid ent) pause))
)
)
)
)

En comparant les solutions proposées, tu trouvera tout seul pour mettre à ton gout. ;)

[(gile)]

Salut,

 

C'est la routine Pline-entroid (la "grosse", réponse 7, qui utilise les routines Algeb-Area, Triangle-Centroid et Polyarc-Centroid) que je recommande d'utiliser plutôt que Vl-Pline-Centroid (de la réponse 8), qui, bien que plus coute est plus lente (et moins précise dans les SCU non parallèles au SCG).

 

Ces 2 routines, tout comme gp que tu avais trouvé, requièrent un argument (nom d'entité d'une polyligne) et retournent un point (coordonnées SCG).

Elles sont faites pour être intégrées dans d'autres LISP comme ceux proposés par Patrick_35 et Bonuscad ou Pt-Cen donné en exemple dans le lien.

 

Je te recommande donc de charger la "grosse" rourtine Pline-Centroid (avec les routines qui l'accompagnent) et d'essayer les solutions proposées que je me permet d'adapter pour qu'elles fonctionnent aussi si le SCU est différent du SCG.

 

La proposition Bonuscad :

 

(defun c:Mov_rotat-centroid (/ js ent key pt)
 (while (null (setq js (ssget "_:S" '((0 . "LWPOLYLINE"))))))
 (if js
   (progn
     (setq ent (ssname js 0))
     (initget "Deplacer Rotation Polyligne")
     (setq key (getkword "\n[Deplacer/Rotation/Polyligne]: "))
     (cond
((eq key "Polyligne")
 (command "_.pline"
	  "_none"
	  (trans (pline-centroid ent) 0 1)
	  (while (not (zerop (getvar "cmdactive"))) (command pause))
 )
)
((eq key "Rotation")
 (command "_.rotate"
	  ent
	  ""
	  (trans (pline-centroid ent) 0 1)
	  pause
 )
)
(T
 (command "_move"
	  ent
	  ""
	  (trans (pline-centroid ent) 0 1)
	  pause
 )
)
     )
   )
 )
) 

 

Tu entres mov_rotat-centroid à la ligne de commande, tu sélectionnes une polyligne puis spécifies une option.

Tu peux renommer la commande en remplaçant Mov_rotat-centroid dans (defun c:Mov_rotat-centroid ...). attention de ne pas utiliser un nom de commande ou un alias déjà défini.

 

La proposition de Patrick_35 :

 

(defun pgp (/ pol)
 (if (setq pol (car (entsel "\n pointez une polyligne ")))
   (trans (pline-centroid pol) 0 1)
 )
) 

 

Dans une des commandes AutoCAD qui demande de spécifier un point au lieu de spécifier le point à l'écran ou en entrant ses coordonnées, tu entres (pgp) à la ligne de commande, puis tu sélectionnes la polyligne dont tu veux que le centre de gravité soit uilisé.

 

[Edité le 7/2/2008 par (gile)]

[jeanmi66]

Ok Gile, ça marche à merveille ! Merci de vos explicaions à tous !

 

Juste une petite dernière chose :

 

J'ai compris et réussi à adapté la routine de Bonuscad de la réponse 2

 

Si j'essaie de mettre les deux routines ensembles, je parle de la dernière de Gile qu'il a parfaitement adapté, à celle de Bonuscad dans la réponse 2, il y a un conflit et celle de Bonuscad n'est pas reconnu.

 

Je voudrais savoir ce que je dois changer dans celle de Bonnuscad, de sa réponse 2, pour qu'elle marche aussi ?

 

Merci encore

[(gile)]

Je ne comprends pas ce que tu veux faire. Les routines de Bonuscad (réponse 2, réponse 8, ainsi que celle que j'ai adaptée) font la même chose si toutes les expressions (gp ent) pour la réponse 2 et (pline-centroid ent) pour la réponse 8 ont été remplacées par (trans (pline-centroid) 0 1) comme dans celle que j'ai adaptée.

 

La différence entre la première routine de Bonuscad (réponse 2) et les autres est la manière dont on appelle ces routines.

La première est une fonction lambda (anonyme) il faut coller tout le code sur la ligne de commande pour la lancer.

Les autres sont des fonctions nommées, definies avec (defun c:... ), il faut entrer à la ligne de commande le nom de la fonction (ce qu'il y a juste après le c: )

 

[jeanmi66]

Ok, alors je vais te présenter comment est disposé mon fichier. J'ai juste changé tout ce qui était GP etc... pour l'adapter au clavier et raccourcis existant de mon bureau. Tel que, la commande BCD fonctionne (routine BONUSCAD) mais pas la tienne GILE.

 

Si je supprime du fichier la routine de BONUSCAD, la tienne GILE fonctionne. J'en déduis qu'il y a conflit entre les deux. Moi, j'ai besoin de pouvoir accrocher barycentre ET centre d'inertie.

 

Dis-moi où est mon erreur stp ?

 

Merci...

 

;;================================================================;;
;;; Donne le barycentre d'une polyligne en info bulle (Point d'équilibre des poids)

(defun C:BC ( / pol cdg)
(setq pol (car (entsel "\n pointez une polyligne")))
(if (setq cdg (BC pol))
(alert (strcat "Barycentre : " (rtos (car cdg) 2 3) " , " (rtos (cadr cdg) 2 3)))
)
)

(defun BC (pol / ent lp)
(if (and pol (= "LWPOLYLINE" (cdr (assoc 0 (setq ent (entget pol))))))
(setq lp (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) ent)))
(print "pas une polyligne !!! ")
)
(if lp
(List
(/ (apply '+ (mapcar 'car lp)) (length lp))
(/ (apply '+ (mapcar 'cadr lp)) (length lp))
)
)
) 


;;================================================================;;
;;; Accroche le barycentre d'une polyligne puis propose 3 solutions

((defun C:BCD ( / js ent key)
(while (null (setq js (ssget "_:S" '((0 . "LWPOLYLINE"))))))
(if js
(progn
(setq ent (ssname js 0))
(initget "Deplacer Rotation Polyligne")
(setq key (getkword "\n[Deplacer/Rotation/Polyligne]< Deplacer >: "))
(cond
((eq key "Polyligne") (command "_.pline" "_none" (BC ent) (while (not (zerop (getvar "cmdactive"))) (command pause))))
((eq key "Rotation") (command "_.rotate" ent "" (BC ent) pause))
(T (command "_move" ent "" (BC ent) pause))
)
)
)
))


;;================================================================;;
;;================================================================;;
;;; Algorythmes de calculs pour accrocher les centres d'inertie
;;================================================================;;
;;================================================================;;

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


;;================================================================;;
;;; Accroche le centre d'inertie d'une polyligne puis propose 3 solutions

(defun C:CGR (/ js ent key pt)
(while (null (setq js (ssget "_:S" '((0 . "LWPOLYLINE"))))))
(if js
(progn
(setq ent (ssname js 0))
(initget "Deplacer Rotation Polyligne")
(setq key (getkword "\n[Deplacer/Rotation/Polyligne]< Deplacer >: "))
(cond
((eq key "Polyligne")
(command "_.pline"
"_none"
(trans (pline-centroid ent) 0 1)
(while (not (zerop (getvar "cmdactive"))) (command pause))
)
)
((eq key "Rotation")
(command "_.rotate"
ent
""
(trans (pline-centroid ent) 0 1)
pause
)
)
(T
(command "_move"
ent
""
(trans (pline-centroid ent) 0 1)
pause
)
)
)
)
)
)

[(gile)]

Supprime juste la première parenthèse ouvrante et la dernière parenthèse fermante dans dans [surligneur]([/surligneur](defun C:BCD ...)[surligneur])[/surligneur]

[jeanmi66]

Merci Giles, merci à tous, c'est parfait.

 

:D :D :D