(gile)

En tout cas, ce n'est pas interdit d'essayer de le faire, c'est certainement un bon exercice.

Je ne vois pas en quoi c'est "plus facile". Dans les exemples que tu donnes, il suffit d'utiliser (cdr ...) au lieu de (cadr ...). (cadr ...) est la contraction de (car (cdr ...)), donc cadr est un petit peu plus complexe que cdr. De plus, dans une liste d'association, l'emploi de paires pointées peut être mélangé à celui de listes classiques comme dans les listes DXF renvoyées par entget en permettant un fonctionnement cohérent avec cdr pour accéder à la "valeur" : Commande: (cdr '(70 . 1)) 1 Commande: (cdr '(10 25.4 3.14 0.0)) (25.4 3.14 0.0)

itoa

Quel est le type de LignXls ? Pourquoi rtos ?

Comprendre de LISP c'est comprendre les manipulations de listes et les fonctions fondamentales de manipulation des listes sont: cons, car et cdr. Pour des information sur les 'listes' LISP voir ce sujet.

Ça ne serait pas suffisant. Si @kitto veut priver ses clients des formules de champ, il faut aussi supprimer ces formules dans les définitions de bloc.

Salut, Des fonctions que j'avais écrites pour le GetExcel de Terry Miller. Ça a plus de 20 ans mais ça fonctionne toujours. ;------------------------------------------------------------------------------- ; ColumnRow - Returns a list of the Column and Row number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (ColumnRow "ABC987") = '(731 987) ;------------------------------------------------------------------------------- (defun ColumnRow (Cell$ / Column$ Char$ Row#) (setq Column$ "") (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91) (setq Column$ (strcat Column$ Char$) Cell$ (substr Cell$ 2) );setq );while (if (and (/= Column$ "") (numberp (setq Row# (read Cell$)))) (list (Alpha2Number Column$) Row#) '(1 1);default to "A1" if there's a problem );if );defun ColumnRow ;------------------------------------------------------------------------------- ; Alpha2Number - Converts Alpha string into Number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Str$ = String to convert ; Syntax example: (Alpha2Number "ABC") = 731 ;------------------------------------------------------------------------------- (defun Alpha2Number (Str$ / Num#) (if (= 0 (setq Num# (strlen Str$))) 0 (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#))) (Alpha2Number (substr Str$ 2)) );+ );if );defun Alpha2Number ;------------------------------------------------------------------------------- ; Number2Alpha - Converts Number into Alpha string ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Num# = Number to convert ; Syntax example: (Number2Alpha 731) = "ABC" ;------------------------------------------------------------------------------- (defun Number2Alpha (Num# / Val#) (if (< Num# 27) (chr (+ 64 Num#)) (if (= 0 (setq Val# (rem Num# 26))) (strcat (Number2Alpha (1- (/ Num# 26))) "Z") (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#))) );if );if );defun Number2Alpha ;------------------------------------------------------------------------------- ; Cell-p - Evaluates if the argument Cell$ is a valid cell ID ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = String of the cell ID to evaluate ; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil ;------------------------------------------------------------------------------- (defun Cell-p (Cell$) (and (= (type Cell$) 'STR) (or (= (strcase Cell$) "A1") (not (equal (ColumnRow Cell$) '(1 1))) );or );and );defun Cell-p ;------------------------------------------------------------------------------- ; Row+n - Returns the cell ID located a number of rows from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of rows from cell ; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9" ;------------------------------------------------------------------------------- (defun Row+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#)))) );defun Row+n ;------------------------------------------------------------------------------- ; Column+n - Returns the cell ID located a number of columns from cell ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 2 ; Cell$ = Starting cell ID ; Num# = Number of columns from cell ; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12" ;------------------------------------------------------------------------------- (defun Column+n (Cell$ Num#) (setq Cell$ (ColumnRow Cell$)) (strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$))) );defun Column+n

Salut, Pour résumer, tu voudrais que quelqu'un te fournisse gracieusement un programme LISP relativement complexe parce que tu ne veux pas partager quelques formules de champ dynamique.

Salut, Ce LISP cherche un attribut du bloc dont la valeur est un nombre et utilise ce nombre comme coordonnée X pour déplacer le bloc. Si tu veux que ça fonctionne avec un attribut dont la valeur n'est pas un nombre, il faut que tu explique comment tu souhaite que les blocs soir déplacés et que tu fournisse un (ou plusieurs) fichiers ave des exemple de blocs pertinents.

Quel intérêt puisque PyAutoCAD utilise la même interface COM/ActiveX. Ne peut on pas faire directement : accad = Autocad() doc = accad.ActiveDocument doc.PurgeAll() doc.Save()

Une version qui utilise un calcul géométrique plutôt que la sélection polygonale pour détecter les "ilots". Elle détecte bien tous les "ilots" mais elle génère toujours une erreur sur certaines polylignes (CF fichier joint). Mais il faut être patient, le traitement est plus long. (defun c:DETECTILOTS (/ massoc isPtInside bbox isInsideBbox pl elst pts minPt maxPt ss i ) (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) (defun isPtInside (pt pts / r) (mapcar '(lambda (p1 p2) (if (and (/= (< (cadr pt) (cadr p1)) (< (cadr pt) (cadr p2))) (< (car pt) (+ (/ (* (- (car p2) (car p1)) (- (cadr pt) (cadr p1)) ) (- (cadr p2) (cadr p1)) ) (car p1) ) ) ) (setq r (not r)) ) ) (cons (last pts) pts) pts ) r ) (defun bbox (pts) ((lambda (p1 p2) (list p1 (list (car p2) (cadr p1)) p2 (list (car p1) (cadr p2)) ) ) (apply 'mapcar (cons 'min pts)) (apply 'mapcar (cons 'max pts)) ) ) (if (and (setq pl (car (entsel "\nSélectionnez une polyligne: "))) (setq elst (entget pl)) (= (cdr (assoc 0 elst)) "LWPOLYLINE") ) (progn (setq points (massoc 10 elst) bbx (bbox points) ) (command-s "_.zoom" "_window" (car bbx) (caddr bbx)) (if (setq ss (ssget "_W" (car bbx) (caddr bbx) '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)) ) ) (repeat (setq i (sslength ss)) (setq pl (ssname ss (setq i (1- i))) pts (massoc 10 (entget pl)) ) (if (or (vl-every '(lambda (p) (isPtInside p points)) (bbox pts) ) (vl-every '(lambda (p) (isPtInside p points)) pts ) ) (setpropertyvalue pl "Color" "5") ) ) ) (command-s "_.zoom" "_previous") ) ) (princ) ) Depassement des limites.dwg

Comme expliqué plus haut, la détection de polygones internes n'est pas fiable sur de tels fichiers avec des polylignes ayant plusieurs milliers de sommets. Tu peux essayer sur ton fichier la routine ci-dessous. Elle demande de sélectionner une seule polyligne pour détecter les polylignes internes et les mettre en bleu. Tu constateras que, suivant la polyligne sélectionnée : - parfois ça fonctionne comme espéré, - parfois ça ne détecte pas les polylignes internes, - parfois ça déclenche une erreur: "Une erreur matérielle s'est produite *** limite de la pile interne atteinte (simulation)" (defun c:ILOTS (/ pl elst pts ss i) (if (and (setq pl (car (entsel "\nSélectinnez une polyligne: "))) (setq elst (entget pl)) (= (cdr (assoc 0 elst)) "LWPOLYLINE") ) (progn (command-s "_.zoom" "_object" pl "") (setq pts (massoc 10 elst)) (if (setq ss (ssget "_WP" pts)) (repeat (setq i (sslength ss)) (setpropertyvalue (ssname ss (setq i (1- i))) "Color" "5") ) ) (command-s "_.zoom" "_previous") ) ) (princ) )

Il faut faire une sélection par Trajet (_Fence) (defun c:SSFPL (/ massoc pl elst pts ss) (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) (if (and (setq pl (car (entsel "\nSélectionnez une polyligne: "))) (= (cdr (assoc 0 (setq elst (entget pl)))) "LWPOLYLINE") ) (progn (setq pts (massoc 10 elst)) (if (= (logand 1 (cdr (assoc 70 elst))) 1) (setq pts (append pts (list (car pts)))) ) (setq pts (mapcar '(lambda (p) (trans p pl 1)) pts)) (setq ss (ssget "_F" pts)) (ssdel pl ss) (sssetfirst nil ss) ) ) (princ) )

Il faut que les fonctions plineSignedArea et isClockwise soient aussi chargée. Le code complet: ;; massoc ;; Renvoie la liste de toutes les valeurs pour la clé spécifiée (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) ;; plineSignedArea ;; Obtient l'aire algébrique (signée) de la polyligne (defun plineSignedArea (pline / triangleArea arcArea elst lst area p0) (defun triangleArea (p1 p2 p3) (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1))) ) ) (defun arcArea (p1 p2 bulge / ang rad) (setq ang (* 2 (atan bulge)) rad (/ (distance p1 p2) (* 2 (sin ang))) ) (* rad rad (- (* 2 ang) (sin (* 2 ang)))) ) (setq elst (entget pline)) (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) area 0.0 p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq area (arcArea p0 (caadr lst) (cdar lst))) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (+ area (triangleArea p0 (caar lst) (caadr lst)))) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst)))) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) p0 (cdar lst)))) ) (/ area 2.) ) ;; isClockwise ;; Evalue si la polyligne est en sens horaire (defun isClockwise (pline) (minusp (plineSignedArea pline))) ;; Met en couleur orange (30) les polylignes fermées en sens anti-horaire. (defun c:SENSPOLY (/ ss i pline) (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))) (progn (repeat (setq i (sslength ss)) (setq pline (ssname ss (setq i (1- i)))) (if (not (IsClockwise pline)) (setpropertyvalue pline "Color" "30"); couleur orange "30" ) ) ) ) (princ) )

En fait il y a un problème avec la "détection d'ilots" telle qu'elle est faite avec une sélection par fenêtre polygonales et certaines polylignes qui ont un nombre de sommets qui dépasse la limite. Je ne suis pas sûr qu'il soit possible de contourner ce problème en LISP.

Le problème ne vient pas du code LISP mais des limites d'AutoCAD quand on veut traiter avec un LISP plus de 2000 polylignes d'un seul coup en insérant un bloc sur chaque segment quand certaines polylignes ont plusieurs milliers de sommets et, dans le même temps, de détecter des ilots. Je te propose d'alléger un peu la tâche en séparant les deux traitement et en remplaçant l'insertion de dizaines de milliers de flèches par un simple changement de couleur. Edit : La détection de polylignes "intérieures" provoque une "erreur matérielle" : "limite de la pile interne atteinte (simulation)" avec certaines polylignes ayant "trop de sommets". ;; Met en couleur orange (30) les polylignes fermées en sens anti-horaire. (defun c:SENSPOLY (/ ss i pline) (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))) (progn (repeat (setq i (sslength ss)) (setq pline (ssname ss (setq i (1- i)))) (if (not (IsClockwise pline)) (setpropertyvalue pline "Color" "30"); couleur orange "30" ) ) ) ) (princ) )

Une commande pour copier les remplacements de couleur d'une fenêtre à une autre qui utilise les fonctions données plus haut. (defun c:MatchLayerColorOverride (/ source data target) (if (and (setq source (car (entsel "\nSélectionnez la fenêtre source: "))) (= (cdr (assoc 0 (entget source))) "VIEWPORT") (setq data (getViewportLayerColorOverrides source)) (setq target (car (entsel "\nSélectionnez la fenêtre cible: "))) (= (cdr (assoc 0 (entget target))) "VIEWPORT") ) (foreach pair data (command-s "_.VPLAYER" "_Color" (cdr pair) (getpropertyvalue (car pair) "Name") "_Select" target "" "" ) ) ) (princ) )

Il faut que tu utilises VPLAYER (ou les fonction vla*), parce qu'on ne peut pas modifier une fenêtre flottante avec entmod.

Quelque chose comme ça ? Edit : ajout de commentaires (entêtes) ;; Obtient les remplacements de couleur par fenêtre pour le calque spécifié. ;; ;; Argument ;; layer : ename du calque ;; ;; Valeur renvoyée ;; une liste de paires pointées : (<ename de la fenêtre> . <couleur de remplacement>) ou nil. (defun getColorOverrides (layer / xdict data lst) (if (and (setq xdict (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget layer)))) (setq data (dictsearch xdict "ADSK_XREC_LAYER_COLOR_OVR")) ) (while (setq data (member '(102 . "{ADSK_LYR_COLOR_OVERRIDE") data)) (setq lst (cons (cons (cdr (assoc 335 data)) (cdr (assoc 420 data)) ) lst ) data (cdr data) ) ) ) lst ) ;; Obtient les calques aux couleurs remplacées pour la fenêtre flottante spécifiée. ;; ;; Argument ;; viewport : ename de la fenetre ;; ;; Valeur renvoyée ;; une liste de paires pointées : (<ename du calque> . <couleur de remplacement>) ou nil. (defun getViewportLayerColorOverrides (viewport / layer override lst) (while (setq layer (tblnext "LAYER" (not layer))) (setq layer (tblobjname "LAYER" (cdr (assoc 2 layer)))) (if (setq override (assoc viewport (getColorOverrides layer))) (setq lst (cons (cons layer (cdr override)) lst)) ) ) lst ) ;; Convertit la valeur négative d'un groupe DXF 420 (telle que celle des remplacement de couleur de calque) en couleur de l'index ou couleur vraie. ;; ;; Argument ;; dxf420 : valeur d'un groupe DXF 420 négatif. ;; ;; Valeur renvoyée ;; une paire pointée dont le premier terme est "ColorIndex" ou "TrueColor" et le second la valeur. (defun dxf420->color (dxf420) (if (zerop (logand dxf420 (lsh 1 24))) (cons "TrueColor" (boole 2 dxf420 (lsh 194 24))) (cons "ColorIndex" (boole 2 dxf420 (lsh 195 24))) ) ) (defun c:test (/ vp color) (if (and (setq vp (car (entsel "\nSélectionnez une fenêtre flottante: "))) (= (cdr (assoc 0 (entget vp))) "VIEWPORT") ) (foreach l (getViewportLayerColorOverrides vp) (setq color (dxf420->color (cdr l))) (prompt (strcat "\nCalque : " (getpropertyvalue (car l) "Name") " " (car color) " : " (itoa (cdr color)) ) ) ) ) (princ) )

Ça devrait répondre à la demande. ;; massoc ;; Renvoie la liste de toutes les valeurs pour la clé spécifiée (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) ;; plineSignedArea ;; Obtient l'aire algébrique (signée) de la polyligne (defun plineSignedArea (pline / triangleArea arcArea elst lst area p0) (defun triangleArea (p1 p2 p3) (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1))) ) ) (defun arcArea (p1 p2 bulge / ang rad) (setq ang (* 2 (atan bulge)) rad (/ (distance p1 p2) (* 2 (sin ang))) ) (* rad rad (- (* 2 ang) (sin (* 2 ang)))) ) (setq elst (entget pline)) (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) area 0.0 p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq area (arcArea p0 (caadr lst) (cdar lst))) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (+ area (triangleArea p0 (caar lst) (caadr lst)))) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst)))) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) p0 (cdar lst)))) ) (/ area 2.) ) ;; isClockwise ;; Evalue si la polyligne est en sens horaire (defun isClockwise (pline) (minusp (plineSignedArea pline))) ;; makeArrowBlock ;; Crée le bloc "CwArrow" s'il n'existe pas (defun makeArrowBlock () (if (null (tblsearch "BLOCK" "CwArrow")) (progn (entmakex '((0 . "BLOCK") (2 . "CwArrow") (70 . 0) (10 0.0 0.0 0.0)) ) (entmakex '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbPolyline") (90 . 7) (70 . 129) (10 -25.0 -2.5) (10 0.0 -2.5) (10 0.0 -12.5) (10 25.0 0.0) (10 0.0 12.5) (10 0.0 2.5) (10 -25.0 2.5) ) ) (entmakex '((0 . "ENDBLK"))) ) ) ) ;; insertArrowBlock ;; Insère le bloc "CwArrow" (defun insertArrowBlock (position rotation) (entmakex (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 100 "AcDbBlockReference") (cons 2 "CwArrow") (cons 10 position) (cons 50 rotation) ) ) ) ;; midPoint ;; renvoie le milieu de deux points (defun midPoint (pt1 pt2) (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.))) p1 p2) ) ;; insertArrowOnPline ;; Insère le bloc "CwArrow" sur chaque segment de la polyligne (defun insertArrowOnPline (pline / pts) (makeArrowBlock) (setq pts (massoc 10 (entget pline)) lst (mapcar (function (lambda (p1 p2) (list (midPoint p1 p2) (angle p1 p2)) ) ) pts (append (cdr pts) (list (car pts))) ) ) (foreach p lst (apply 'insertArrowBlock p)) ) ;; Commande de test (defun c:test (/ ss1 i pline ss2 j) (if (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))) (progn (command-s "_.zoom" "_extents") (repeat (setq i (sslength ss1)) (setq pline (ssname ss1 (setq i (1- i)))) (if (not (IsClockwise pline)) (insertArrowOnPline pline) ) (if (setq ss2 (ssget "_WP" (massoc 10 (entget pline)) '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)) ) ) (repeat (setq j (sslength ss2)) (setpropertyvalue (ssname ss2 (setq j (1- j))) "Color" "5") ) ) ) (command-s "_.zoom" "_previous") ) ) (princ) )

Salut, Pour Python avec AutoCAD, tu devrais aussi regarder du côté de PyRx, c'est 'wrapper' d'ObjectARX pour Python développé par Daniel (un pilier de TheSwamp aussi auteur de SqLite for AutoLISP, une bibliothèque de fonctions LISP pour travailler avec les bases de données SQLite). Blog : https://pyarx.blogspot.com/ Forum de discussion : https://www.theswamp.org/index.php?board=76.0

Ce n'est plus du tout la demande initiale dans laquelle le sens est déterminé par le fait que la polyligne soit "interne" ou "externe". C'est dans la demande initiale. De toutes façons sens horaire/anti-horaire n'a de sens que si la polyligne est fermée.

Cette version devrait répondre à la demande de @TUAU. ;; plineSignedArea ;; Obtient l'aire algébrique (signée) de la polyligne (defun plineSignedArea (pline / triangleArea arcArea elst lst area p0) (defun triangleArea (p1 p2 p3) (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1))) ) ) (defun arcArea (p1 p2 bulge / ang rad) (setq ang (* 2 (atan bulge)) rad (/ (distance p1 p2) (* 2 (sin ang))) ) (* rad rad (- (* 2 ang) (sin (* 2 ang)))) ) (setq elst (entget pline)) (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) area 0.0 p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq area (arcArea p0 (caadr lst) (cdar lst))) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (+ area (triangleArea p0 (caar lst) (caadr lst)))) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst)))) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) p0 (cdar lst)))) ) (/ area 2.) ) ;; isClockwise ;; Evalue si la polyligne est en sens horaire (defun isClockwise (pline) (minusp (plineSignedArea pline))) ;; reversePline ;; Inverse l'ordre des sommets de la polyligne (defun reversePline (ent / split dxfLst vrtxLst lastVrtx) (defun split (l) (if l (cons (list (car l) (cadr l) (caddr l) (cadddr l)) (split (cddddr l)) ) ) ) (setq dxfLst (entget ent)) (setq vrtxLst (reverse (split (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42))) dxfLst ) ) ) dxfLst (vl-remove-if '(lambda (x) (member (car x) '(10 40 41 42))) dxfLst ) ) (setq lastVrtx (last vrtxLst) lastVrtx (subst (cons 40 (cdr (assoc 41 (car vrtxLst)))) (assoc 40 lastVrtx) (subst (cons 41 (cdr (assoc 40 (car vrtxLst)))) (assoc 41 lastVrtx) (subst (cons 42 (- (cdr (assoc 42 (car vrtxLst))))) (assoc 42 lastVrtx) lastVrtx ) ) ) ) (setq vrtxLst (mapcar '(lambda (x y) (setq x (subst (cons 40 (cdr (assoc 41 y))) (assoc 40 x) (subst (cons 41 (cdr (assoc 40 y))) (assoc 41 x) (subst (cons 42 (- (cdr (assoc 42 y)))) (assoc 42 x) x ) ) ) ) ) vrtxLst (cdr vrtxLst) ) ) (if (= (logand 1 (cdr (assoc 70 dxfLst))) 1) (setq vrtxLst (append (list lastVrtx) vrtxLst)) (setq vrtxLst (append vrtxLst (list lastVrtx))) ) (setq dxfLst (append dxfLst (apply 'append vrtxLst))) (entmod dxfLst) ) ;; massoc ;; Renvoie la liste de toutes les valeurs pour la clé spécifiée (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) ;; Commande de test (defun c:test (/ ss i pline plines ccwPlines) ;; invite "sélection de polyligne" ;; on fait une sélection classique autocad (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (progn (repeat (setq i (sslength ss)) (setq pline (ssname ss (setq i (1- i)))) ;; Clore les polylignes et les mettre aux sens de parcours horaires (if (zerop (getpropertyvalue pline "Closed")) (setpropertyvalue pline "Closed" 1) ) (setq plines (cons pline plines)) ) ;; Détecter les polylignes fermées internes à d'autres (command-s "_.zoom" "_extents") (foreach pline plines (if (setq ss (ssget "_WP" (massoc 10 (entget pline)) '((0 . "LWPOLYLINE")) ) ) (repeat (setq i (sslength ss)) (setq ccwPlines (cons (ssname ss (setq i (1- i))) ccwPlines)) ) ) ) (command-s "_.zoom" "_previous") ;; Attribuer le sens des polylignes (foreach pline plines (if (member pline ccwPlines) (if (IsClockwise pline) (reversePline pline) ) (if (not (IsClockwise pline)) (reversePline pline) ) ) ) ) ) (princ) )

Salut, J'avais mal compris la demande, je pensais qu'on ne sélectionnait que les polylignes en contenant d'autres. Partir de toutes les polylignes et les trier suivant qu'elles sont à l'intérieur d'une autre ou pas n'est pas une chose simple.

;; plineSignedArea ;; Obtient l'aire algébrique (signée) de la polyligne (defun plineSignedArea (pline / triangleArea arcArea elst lst area p0) (defun triangleArea (p1 p2 p3) (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1))) ) ) (defun arcArea (p1 p2 bulge / ang rad) (setq ang (* 2 (atan bulge)) rad (/ (distance p1 p2) (* 2 (sin ang))) ) (* rad rad (- (* 2 ang) (sin (* 2 ang)))) ) (setq elst (entget pline)) (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) area 0.0 p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq area (arcArea p0 (caadr lst) (cdar lst))) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (+ area (triangleArea p0 (caar lst) (caadr lst)))) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst)))) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq area (+ area (arcArea (caar lst) p0 (cdar lst)))) ) (/ area 2.) ) ;; isClockwise ;; Evalue si la polyligne est en sens horaire (defun isClockwise (pline) (minusp (plineSignedArea pline))) ;; reversePline ;; Inverse l'ordre des sommets de la polyligne (defun reversePline (ent / split dxfLst vrtxLst lastVrtx) (defun split (l) (if l (cons (list (car l) (cadr l) (caddr l) (cadddr l)) (split (cddddr l)) ) ) ) (setq dxfLst (entget ent)) (setq vrtxLst (reverse (split (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42))) dxfLst ) ) ) dxfLst (vl-remove-if '(lambda (x) (member (car x) '(10 40 41 42))) dxfLst ) ) (setq lastVrtx (last vrtxLst) lastVrtx (subst (cons 40 (cdr (assoc 41 (car vrtxLst)))) (assoc 40 lastVrtx) (subst (cons 41 (cdr (assoc 40 (car vrtxLst)))) (assoc 41 lastVrtx) (subst (cons 42 (- (cdr (assoc 42 (car vrtxLst))))) (assoc 42 lastVrtx) lastVrtx ) ) ) ) (setq vrtxLst (mapcar '(lambda (x y) (setq x (subst (cons 40 (cdr (assoc 41 y))) (assoc 40 x) (subst (cons 41 (cdr (assoc 40 y))) (assoc 41 x) (subst (cons 42 (- (cdr (assoc 42 y)))) (assoc 42 x) x ) ) ) ) ) vrtxLst (cdr vrtxLst) ) ) (if (= (logand 1 (cdr (assoc 70 dxfLst))) 1) (setq vrtxLst (append (list lastVrtx) vrtxLst)) (setq vrtxLst (append vrtxLst (list lastVrtx))) ) (setq dxfLst (append dxfLst (apply 'append vrtxLst))) (entmod dxfLst) ) ;; massoc ;; renvoie la liste de toutes les valeurs pour la clé spécifiée (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) ;; Commande de test (defun c:test (/ ss1 i pline ss2 j) ;; invite "sélection de polyligne" ;; on fait une sélection classique autocad (if (setq ss1 (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss1)) (setq pline (ssname ss1 (setq i (1- i)))) ;; Clore les polylignes et les mettre aux sens de parcours horaires (if (zerop (getpropertyvalue pline "Closed")) (setpropertyvalue pline "Closed" 1) ) (if (not (IsClockwise pline)) (reversePline pline) ) ;; Détecter les polylignes fermées internes à d'autres (if (setq ss2 (ssget "_WP" (massoc 10 (entget pline)) '((0 . "LWPOLYLINE")) ) ) (repeat (setq j (sslength ss2)) (setq pline (ssname ss2 (setq j (1- j)))) ;; mettre ces derniers dans le sens de parcours anti-horaire. (if (IsClockwise pline) (reversePline pline) ) ) ) ) ) (princ) )