Déméter_33 Posté(e) le 24 mai Partager Posté(e) le 24 mai 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 Lien vers le commentaire Partager sur d’autres sites More sharing options...
(gile) Posté(e) le 24 mai Partager Posté(e) le 24 mai 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 ) ) Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD Lien vers le commentaire Partager sur d’autres sites More sharing options...
Déméter_33 Posté(e) le 24 mai Auteur Partager Posté(e) le 24 mai (modifié) 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 par Déméter_33 Etude de la réponse apportée Lien vers le commentaire Partager sur d’autres sites More sharing options...
(gile) Posté(e) le 24 mai Partager Posté(e) le 24 mai 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. Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD Lien vers le commentaire Partager sur d’autres sites More sharing options...
Déméter_33 Posté(e) le 24 mai Auteur Partager Posté(e) le 24 mai (modifié) 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 par Déméter_33 Ajout de précisions Lien vers le commentaire Partager sur d’autres sites More sharing options...
(gile) Posté(e) le 24 mai Partager Posté(e) le 24 mai 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 ) ) Gilles Chanteau - gileCAD - GitHub Développements sur mesure pour AutoCAD Lien vers le commentaire Partager sur d’autres sites More sharing options...
Déméter_33 Posté(e) le 24 mai Auteur Partager Posté(e) le 24 mai 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. Lien vers le commentaire Partager sur d’autres sites More sharing options...
Déméter_33 Posté(e) le 27 mai Auteur Partager Posté(e) le 27 mai 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) Lien vers le commentaire Partager sur d’autres sites More sharing options...
Messages recommandés
Créer un compte ou se connecter pour commenter
Vous devez être membre afin de pouvoir déposer un commentaire
Créer un compte
Créez un compte sur notre communauté. C’est facile !
Créer un nouveau compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant