Obtention impossible des coordonnees centroides !

[Déméter_33]

Bonjour,

Je m'explique (le titre est peut être ambigu) : à la suite d'un sujet précédent, auquel j'avais obtenu une bonne solution, j'ai commencé à me servir du LISP joint.

Je me suis rendu compte que au cours de l'exécution, certaines polylignes (ouvertes) sortaient sans informations des coordonnées de centroïdes.

En cherchant d'où viens l'erreur, je me suis redu compte que les polylignes qui n'exportent pas d'informations sont celles qui une fois fermées s'intersectent elles mêmes (en gros un S se transforme en $).

Je me demande donc si il y a un moyen de contourner ce problème.

Le LISP et le fichier que je traite en exemples.

Statextrat.lsp Export vers statistiques - Test 3.dwg

[(gile)]

Salut,

Essaye comme ça :

(vl-load-com)
(defun c:Statextract (/
		      js
		      file_name
		      cle
		      f_open
		      key_sep
		      str_sep
		      oldim
		      lst_id
		      lst_length
		      lst_surf
		      lst_closed
		      lst_centroid
		      lst_layer
		      n
		     )
  (princ "\nSélectionner les polylignes optimisées.")
  (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSélection vide, ou ce ne sont pas des LWPOLYLINE!"
    )
  )
  ;; pour déterminer la précision des décimales que tu veux inscrire dans le fichier
  (command "_.ddunits"
	   (while (not (zerop (getvar "cmdactive")))
	     (command pause)
	   )
  )
  (setq	file_name (getfiled "Nom du fichier a créer ?: "
			    (strcat (substr (getvar "dwgname")
					    1
					    (- (strlen (getvar "dwgname")) 3)
				    )
				    "csv"
			    )
			    "csv"
			    37
		  )
  )
  (if (null file_name)
    (exit)
  )
  (if (findfile file_name)
    (progn
      (prompt "\nFichier éxiste déjà!")
      (initget "Ajoute Remplace annUler _Add Replace Undo")
      (setq cle
	     (getkword
	       "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: "
	     )
      )
      (cond
	((eq cle "Add")
	 (setq cle "a")
	)
	((or (eq cle "Replace") (eq cle ()))
	 (setq cle "w")
	)
	(T (exit))
      )
      (setq f_open (open file_name cle))
    )
    (setq f_open (open file_name "w"))
  )
  (initget
    "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation"
  )
  (setq	key_sep	(getkword
		  "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: "
		)
  )
  (cond
    ((eq key_sep "SPpace") (setq str_sep " "))
    ((eq key_sep "Comma") (setq str_sep ","))
    ((eq key_sep "Tabulation") (setq str_sep "\t"))
    (T (setq str_sep ";"))
  )
  (setq oldim (getvar "dimzin"))
  ;; pour écrire tous les zéro, même ceux qui se révèlent inutiles.
  (setvar "dimzin" 0)
  (setq
    lst_id '()
    lst_length '()
    lst_surf '()
    lst_closed '()
    lst_centroid '()
    lst_layer '()
  )
  (repeat (setq n (sslength js))
    (setq ename	   (ssname js (setq n (1- n)))
	  centroid (vl-catch-all-apply 'pline-centroid (list ename))
    )
    (if	(vl-catch-all-error-p centroid)
      (setq centroid nil)
    )
    (setq
      elst	   (entget ename)
      lst_id	   (cons (strcat "'" (cdr (assoc 5 elst))) lst_id)
      lst_length   (cons (getpropertyvalue ename "Length") lst_length)
      lst_surf	   (cons (getpropertyvalue ename "Area") lst_surf)
      lst_closed   (cons (getpropertyvalue ename "Closed") lst_closed)
      lst_centroid (cons centroid lst_centroid)
      lst_layer	   (cons (cdr (assoc 8 elst)) lst_layer)
    )
  )
  (foreach n
	     (reverse
	       (mapcar 'list
		       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_id)
			       (list (strcat "Handle" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_layer)
			       (list (strcat "Calque" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_length)
			       (list (strcat "Longueur" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_surf)
			       (list (strcat "Surface" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (itoa x) str_sep)) lst_closed)
			       (list (strcat "Fermée" str_sep))
		       )
		       (append (mapcar '(lambda	(x)
					  (strcat
					    (if	x
					      (rtos x)
					      ""
					    )
					    str_sep
					  )
					)
				       (mapcar 'car lst_centroid)
			       )
			       (list (strcat "X Centroïd" str_sep))
		       )
		       (append (mapcar '(lambda	(x)
					  (strcat
					    (if	x
					      (rtos x)
					      ""
					    )
					    str_sep
					  )
					)
				       (mapcar 'cadr lst_centroid)
			       )
			       (list (strcat "Y Centroïd" str_sep))
		       )
	       )
	     )
    (write-line (apply 'strcat n) f_open)
  )
  (close f_open)
  (setvar "dimzin" oldim)
  (prin1)
)

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

 

[Déméter_33]

Salut @(gile), lors de l'exécution, je reçois le message d'erreur suivant:

Commande: STATEXTRACT_GILE

Sélectionner les polylignes optimisées.
Sélectionnez des objets: Spécifiez le coin opposé: 750 trouvé(s)

Sélectionnez des objets:
_.ddunits
Commande:
Commande:
Séparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: P
; erreur: division par zéro

Je t'avoue que j'ai exécuté sans regarder ce que tu as fait pour le moment, donc je n'ai pas cherché à comprendre ou tu apporte des modifs.

 

Edit:

Je viens de regarder, et si je comprends bien, tu as rajouté  un ensemble de fonctions complémentaires, qui calculent un centroïde issu d'un calcul de plusieurs centroïdes de triangles formés avec des sections consécutives de la polyligne. Je sais pas si mes mots sont très adaptés...

Modifié le 24 mai 2024 par Déméter_33
Etude de la réponse apportée

[(gile)]

Il y a 2 heures, Déméter_33 a dit :

Sélectionnez des objets: Spécifiez le coin opposé: 750 trouvé(s)

Quand tu fais des tests, tu n'y va pas avec le dos de la cuillère !

Ton dessin contient au moins une polyligne "corrompue" (probablement avec une aire algébrique nulle).

J'ai modifié le code ci-dessus pour que de telles polylignes ne provoquent plus l'arrêt de la routine (elles n'auront pas de coordonnées X et Y pour le centroid)).

 

Il y a 4 heures, Déméter_33 a dit :

En cherchant d'où viens l'erreur, je me suis redu compte que les polylignes qui n'exportent pas d'informations sont celles qui une fois fermées s'intersectent elles mêmes (en gros un S se transforme en $).

Géométriquement, le "centroid" d'une polyligne ouverte n'a pas vraiment de sens, idem pour une polyligne fermée avec auto-intersecion.

[Déméter_33]

Bon du coup je me suis calmé sur le test, je n'ai sélectionné que 64 éléments. (L'objectif est de pouvoir extraire les infos de plusieurs milliers d'éléments en simultané)

Sauf que j'ai toujours la même erreur: ; erreur: division par zéro (A moins que je ne voie pas le code modifié, il n'y a pas de notification "modifié" dans ton code précédent)

En parallèle je suis en train de réfléchir à une autre solution mais je bute un peu...

Une autre solution plausible serait de donner comme point "centroïde" des poly non fermées le point situé au centre de leur longueur totale. Mais je suis encore en train de chercher des bouts de code sur le net qui me permettront de le faire (Je sais que j'ai vu des lisp faire des choses s'en rapprochant à droite et à gauche en farfouillant).

Modifié le 24 mai 2024 par Déméter_33
Ajout de précisions

[(gile)]

Ci-dessous une nouvelle version qui renvoie le milieu des polylignes ouvertes et le centre de gravité des polylignes fermées si celui-ci est calculable (####;#### sinon).

(vl-load-com)
(defun c:Statextract (/
		      js
		      file_name
		      cle
		      f_open
		      key_sep
		      str_sep
		      oldim
		      lst_id
		      lst_length
		      lst_surf
		      lst_closed
		      lst_centroid
		      lst_layer
		      n
		      ename
		      closed
		      centroid
		     )
  (princ "\nSélectionner les polylignes optimisées.")
  (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSélection vide, ou ce ne sont pas des LWPOLYLINE!"
    )
  )
  ;; pour déterminer la précision des décimales que tu veux inscrire dans le fichier
  (command "_.ddunits"
	   (while (not (zerop (getvar "cmdactive")))
	     (command pause)
	   )
  )
  (setq	file_name (getfiled "Nom du fichier a créer ?: "
			    (strcat (substr (getvar "dwgname")
					    1
					    (- (strlen (getvar "dwgname")) 3)
				    )
				    "csv"
			    )
			    "csv"
			    37
		  )
  )
  (if (null file_name)
    (exit)
  )
  (if (findfile file_name)
    (progn
      (prompt "\nFichier éxiste déjà!")
      (initget "Ajoute Remplace annUler _Add Replace Undo")
      (setq cle
	     (getkword
	       "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: "
	     )
      )
      (cond
	((eq cle "Add")
	 (setq cle "a")
	)
	((or (eq cle "Replace") (eq cle ()))
	 (setq cle "w")
	)
	(T (exit))
      )
      (setq f_open (open file_name cle))
    )
    (setq f_open (open file_name "w"))
  )
  (initget
    "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation"
  )
  (setq	key_sep	(getkword
		  "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: "
		)
  )
  (cond
    ((eq key_sep "SPpace") (setq str_sep " "))
    ((eq key_sep "Comma") (setq str_sep ","))
    ((eq key_sep "Tabulation") (setq str_sep "\t"))
    (T (setq str_sep ";"))
  )
  (setq oldim (getvar "dimzin"))
  ;; pour écrire tous les zéro, même ceux qui se révèlent inutiles.
  (setvar "dimzin" 0)
  (setq
    lst_id '()
    lst_length '()
    lst_surf '()
    lst_closed '()
    lst_centroid '()
    lst_layer '()
  )
  (repeat (setq n (sslength js))
    (setq ename	   (ssname js (setq n (1- n)))
	  closed   (getpropertyvalue ename "Closed")
	  centroid (if (zerop closed)
		     (vlax-curve-getPointAtParam
		       ename
		       (/ (- (vlax-curve-getEndParam ename)
			     (vlax-curve-getStartParam ename)
			  )
			  2
		       )
		     )
		     (vl-catch-all-apply 'pline-centroid (list ename))
		   )
    )
    (if	(vl-catch-all-error-p centroid)
      (setq centroid '("####" "####"))
    )
    (setq
      elst	   (entget ename)
      lst_id	   (cons (strcat "'" (cdr (assoc 5 elst))) lst_id)
      lst_length   (cons (getpropertyvalue ename "Length") lst_length)
      lst_surf	   (cons (getpropertyvalue ename "Area") lst_surf)
      lst_closed   (cons closed lst_closed)
      lst_centroid (cons centroid lst_centroid)
      lst_layer	   (cons (cdr (assoc 8 elst)) lst_layer)
    )
  )
  (foreach n
	     (reverse
	       (mapcar 'list
		       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_id)
			       (list (strcat "Handle" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat x str_sep)) lst_layer)
			       (list (strcat "Calque" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_length)
			       (list (strcat "Longueur" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_surf)
			       (list (strcat "Surface" str_sep))
		       )
		       (append (mapcar '(lambda (x) (strcat (itoa x) str_sep)) lst_closed)
			       (list (strcat "Fermée" str_sep))
		       )
		       (append (mapcar '(lambda	(x)
					  (strcat
					    (if	(numberp x)
					      (rtos x)
					      x
					    )
					    str_sep
					  )
					)
				       (mapcar 'car lst_centroid)
			       )
			       (list (strcat "X Centroïd" str_sep))
		       )
		       (append (mapcar '(lambda	(x)
					  (strcat
					    (if	(numberp x)
					      (rtos x)
					      x
					    )
					    str_sep
					  )
					)
				       (mapcar 'cadr lst_centroid)
			       )
			       (list (strcat "Y Centroïd" str_sep))
		       )
	       )
	     )
    (write-line (apply 'strcat n) f_open)
  )
  (close f_open)
  (setvar "dimzin" oldim)
  (prin1)
)

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

 

[Déméter_33]

il y a 28 minutes, (gile) a dit :

Ci-dessous une nouvelle version qui renvoie le milieu des polylignes ouvertes et le centre de gravité des polylignes fermées si celui-ci est calculable (####;#### sinon).

Bon du coup j'ai pas le temps de réfléchir que la solution toute faite me tombe dans les mains.

Je l'ai testé vite fait sur un ensemble de 1857 éléments (avec le dos d'un godet de Komatsu 8000)  et il s'en est très bien sorti après contrôle sur une poly ouverte.

Je le mettrai un peu plus à l'épreuve Lundi mais si c'est bon ça va m’économiser des heures de travail sur plusieurs projets donc...

MERCI.

[Déméter_33]

Une fois mis un peu plus à l'épreuve, ça fonctionne impeccablement.

Je n'ai plus eu qu'à modifier quelques fonctionnalités, comme la transformation auto de toutes les lignes en LWpoly, la désactivation du contrôle de précision de virgule, la définition du séparateur uniquement en ";" et la sélection automatique de toutes les entités du dessin.

J'ai maintenant une routine 100% opé, où en un appel, j'extrait toutes les données nécessaires à une analyse statistique linéaire de toutes les entités d'un dessin.

Merci @(gile)