Aller au contenu

Supprimer TOUS les objets SUPERPOSES


rebcao

Messages recommandés

Bonjour à Toutes et à Tous,

 

Vous connaissez tous la commande OVERKILL ? Elle supprime les DOUBLONS en gardant un objet !

 

Je cherche une commande qui EFFACE tous les objets identiques et superposés (sans tenir compte de leur propriétés) !

 

 

Je vous remercie

 

Christian

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Mais, je ne comprends pas ; de mémoire, OVERKILL peut ignorer les propriétés que tu veux, c'est une commande réglable.

Du coup, j'ai toujours utilisée celle-ci. Enfin pas souvent. :P

 

Tu veux une commande qui efface tout et non se contente de supprimer les doublons ?

Sont-ce deux problématiques ou une seule ?

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Lien vers le commentaire
Partager sur d’autres sites

Oui, je veux que si des objets IDENTIQUES (géométriquement) se superposent, ils soient supprimés TOUS LES DEUX... (ou les cinq s'ils sont superposés 5 fois !)

 

On va dire que les propriétés restent annexes...

 

 

 

 

Christian

 

 

 

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Overkill est un gros lsp (deux fichiers) mais on doit pouvoir y glisser l'effacement.

En s'inspirant de l'outil ou en le modifiant si c'est permis. Car c'est un bon outil. Mais je ne me propose pas pour aujourd'hui, malheureusement.

Si tant est que j'y parviendrais un jour :P

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Lien vers le commentaire
Partager sur d’autres sites

Pffffff....

 

 

 

 

Pas évident de s'y retrouver dans ce source !... (en plus il y en a 2 : OVERKILL.LSP et OVERKILLSUP.LSP...

 

Christian

 

 

 

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Ouais, je les ai regardé. Mais, pas évident de les lire rapidement, n'Est-ce pas ?

J'ai vu, dans un autre message, que tu avais le courage d'entrer dedans !

Enfin, c'est ce que je crois comprendre quand tu te renseignes sur xplode. En tous les cas, bon courage ;)

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

Si le besoin reste simple (traitement d’entité non complexe), il n’est peut-être pas nécessaire de s’attaquer au code OVERKILL.

Oui, je veux que si des objets IDENTIQUES (géométriquement) se superposent, ils soient supprimés TOUS LES DEUX... (ou les cinq s'ils sont superposés 5 fois !)

On va dire que les propriétés restent annexes...

Christian

 

Si tes entités graphiques sont simple, on peut facilement écrire 2 ou 3 lignes de code, il suffit de faire une comparaison avec le type d’entité puis celui des codes dxf se situant à la suite du deuxième marqueur de sous classe (code dxf 100) définissant les caractéristiques graphiques de l’entité.

 

Voilà quelques lignes de code, en espérant qu’elles répondront au besoin, (non testé en profondeur..)

(defun C:DelSuperposition (/ ss i e l m flag DefGeo)
 (defun DefGeo (l / m)
   (cons (car l)
         (cons (cadr l) (cdr (member (assoc 100 (setq m (cdr (member '(100 . "AcDbEntity") l)))) m)))
   )
 )
 (and (setq ss (ssget))
      (repeat (setq i (sslength ss)) (setq l (cons (DefGeo (entget (ssname ss (setq i (1- i))))) l)))
      (while l
        (setq e (car l) m (cdr l) l nil)
        (while m
          (or (and (equal (cdr e) (cdar m) 1.e-8) (setq flag T) (entdel (cdr (assoc -1 (car m))))) (setq l (cons (car m) l)))
          (setq m (cdr m))
        )
        (if flag
          (entdel (cdr (assoc -1 e)))
        )
        (setq flag nil)
      )
 )
 (princ)
)

 

(Ps : Le code échoue sur les entités dimensions qui génère un bloc anonyme différent dans leurs définitions, si tu veux quels soit intégré au traitement fait le savoir, je jetterais un œil dessus lorsque j’aurais un peu plus de disponibilité.. )

 

A+

 

Edit: Correction d'une coquille sur la valeur de tolérance de la fonction equal 1.e-1 -> 1.e-8

Modifié par VDH-Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bonsoir Bruno,

 

Je te remercie pour ton source... Je vais le tester.

 

OUI ! il s'agit d'objet simple ! Uniquement des LIGNES... Pour simplifier le traitement au maximum, je nettoie le dessin au préalable :

 

1. je supprime : les BLOCS, TEXTES, COTES, ARCS, CERCLES

 

2. Je décompose TOUTES les polylignes

 

Il ne reste donc que des lignes. Je ne sais pas encore ce que donne ton prog. mais ça pourrait peut-être simplifier le traitement si l'on sait qu'il n'y a que des LIGNES à traiter ! Car certaines boucles sur + de 100 000 objets moulinent pas mal...

 

Je vais tester

 

Merci

 

Christian

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Il ne reste donc que des lignes. Je ne sais pas encore ce que donne ton prog. mais ça pourrait peut-être simplifier le traitement si l'on sait qu'il n'y a que des LIGNES à traiter ! Car certaines boucles sur + de 100 000 objets moulinent pas mal...

 

Version simplifié pour ne supporter que le traitement des lignes:

 

(defun C:Rebcao	(/ ss i e l m flag AcDbLine)
 (defun AcDbLine (l / m) (cons (car l) (cdr (member '(100 . "AcDbLine") l))))
 (and (setq ss (ssget '((0 . "LINE"))))
      (repeat (setq i (sslength ss))
 (setq l (cons (AcDbLine (entget (ssname ss (setq i (1- i))))) l))
      )
      (while l
 (setq e    (car l)
       m    (cdr l)
       l    nil
       flag nil
 )
 (while	m
   (or (and (equal (cdr e) (cdar m) 1.e-8)
	    (setq flag T)
	    (entdel (cdr (assoc -1 (car m))))
       )
       (setq l (cons (car m) l))
   )
   (setq m (cdr m))
 )
 (if flag
   (entdel (cdr (assoc -1 e)))
 )
      )
 )
 (princ)
)

 

A+ Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Bruno,

 

Je te remercie pour ton programme qui fonctionne parfaitement. Mais le traitement est correct sur un petit dessin, mais dès qu'on passe à 50000 - 100000 lignes ça dure longtemps...

 

Par contre, Gilles est passé par là avec un programme qui traite rapidement les objets en double ou plus... Je laisse le soin à Gilles de publier son source.

 

Encore Merci à Tous.

 

Christian

 

 

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Je rapelle le contexte : comparer géométriquement toutes les lignes d'un dessin pour supprimer toutes celles qui sont superposées quel que soit le nombre de superpositions et le sens des lignes. Il suffit donc, pour déterminer si deux lignes sont superposées de comparer les points de départ et de fin des deux lignes dans un sens et dans l'autre.

 

Pour comparer toutes les lignes d'une liste, l'algorithme "naif" (ou "force brute") consiste à comaprer la première ligne avec toutes les suivantes dans la liste, puis si des lignes superposées sont trouvées, de les supprimer de la liste pour les effacer directement ou les stocker dans une nouvelle liste et de procéder de même avec la ligne suivante et ainsi de suite...

 

Cet algorithme s'avère très lent avec des listes conséquentes. Il faut autour de 200 secondes pour traiter le fichier joint avec le code ci-dessous.

 

(defun c:compare (/ IsEqual ss n ent elst pt1 pt2 lst sub dup toErase t0 t1)

 ;; évalue si deux lignes sont superposées
 (defun IsEqual (l1 l2)
   (or
     (and
(equal (cadr l1) (cadr l2))
(equal (caddr l1) (caddr l2))
     )
     (and
(equal (cadr l1) (caddr l2))
(equal (caddr l1) (cadr l2))
     )
   )
 )

 (setq t0 (* 84600 (getvar 'tdusrtimer)))

 (if (setq ss (ssget "_X" '((0 . "LINE"))))
   (progn

     ;; constitue une liste de sous liste de sous-liste pour chaque ligne
     ;; (ename startPoint endPoint)
     (repeat (setq n (sslength ss))
(setq ent  (ssname ss (setq n (1- n)))
      elst (entget ent)
      pt1  (cdr (assoc 10 elst))
      pt2  (cdr (assoc 11 elst))
      lst  (cons (list ent pt1 pt2) lst)
)
     )

     ;; boucle principale
     (while lst

;; boucle sur chaque élément restant de la liste
(foreach l (cdr lst)
  (if (IsEqual (car lst) l)
    (setq toErase (cons (car l) toErase)
	  lst	  (vl-remove l lst)
	  dup	  T
    )
  )
)
(if dup
  (setq toErase (cons (caar lst) toErase))
)
(setq lst (cdr lst)
      dup nil
)
     )

     ;; supprime toutes les lignes superposées
     (foreach l toErase (entdel l))
   )
 )

 (setq t1 (* 84600 (getvar 'tdusrtimer)))
 (princ (strcat "\nTemps d'exécution : " (rtos (- t1 t0)) " secondes"))

 (princ)
)

 

Une méthode courante pour optmiser ce type de traitement consiste à "diviser pour régner" (divide and conquer), c'est à dire fractionner la liste en sous-listes suivant un critère qui garanti que tous les éléments comparable seront dans la même sous-liste. La boucle n'est alors exécutée que pour chaque sous-liste de dimension (beaucoup) plus petite.

Dans ce cas, j'ai choisi de grouper les lignes par longueurs égales, ce qui permet de les trier par longueur croissante pour facilement constituer les groupes de lignes de longueurs égales.

Avec le code ci-dessous, pour le même fichier, le traitement ne prend plus que 0.9 secondes environ.

 

(defun c:compare (/ IsEqual ss n ent elst pt1 pt2 len lst sub dup toErase t0 t1)

 ;; évalue si deux lignes sont superposées
 (defun IsEqual (l1 l2)
   (or
     (and
(equal (cadr l1) (cadr l2))
(equal (caddr l1) (caddr l2))
     )
     (and
(equal (cadr l1) (caddr l2))
(equal (caddr l1) (cadr l2))
     )
   )
 )

 (setq t0 (* 84600 (getvar 'tdusrtimer)))

 (if (setq ss (ssget "_X" '((0 . "LINE"))))
   (progn

     ;; constitue une liste de sous liste de sous-liste pour chaque ligne
     ;; (longueur ename startPoint endPoint)
     (repeat (setq n (sslength ss))
(setq ent  (ssname ss (setq n (1- n)))
      elst (entget ent)
      pt1  (cdr (assoc 10 elst))
      pt2  (cdr (assoc 11 elst))
      len  (distance pt1 pt2)
      lst  (cons (list len ent pt1 pt2) lst)
)
     )

     ;; trie la liste par longueurs
     (setq lst (vl-sort lst (function (lambda (l1 l2) (< (car l1) (car l2))))))

     ;; boucle principale
     (while lst
(setq len (caar lst))

;; constitue une liste de ligne de longueurs égales
(while (= len (caar lst))
  (setq	sub (cons (cdar lst) sub)
	lst (cdr lst)
  )
)

;; boucle sur la liste de lignes longueurs égales pour chercher les lignes superposées
(while sub
  (foreach l (cdr sub)
    (if	(IsEqual (car sub) l)
      (setq toErase (cons (car l) toErase)
	    sub	    (vl-remove l sub)
	    dup	    T
      )
    )
  )
  (if dup
    (setq toErase (cons (caar sub) toErase))
  )
  (setq	sub (cdr sub)
	dup nil
  )
)
     )

     ;; supprime toutes les lignes superposées
     (foreach l toErase (entdel l))
   )
 )

 (setq t1 (* 84600 (getvar 'tdusrtimer)))
 (princ (strcat "\nTemps d'exécution : " (rtos (- t1 t0)) " secondes"))

 (princ)
)

 

On pourrait certainement optimiser le code pour gratter quelques millisecondes mais on voit bien que l'essentiel de l'optimisation tient à l'algorithmie.

 

En LISP on sera toujours limité par le fait que l'unique structure de données est la liste chaînée qui n'es pas très efficiente dès qu'elle grossi.

 

J'ai fait un test avec le dernier algorithme en .NET et des collections plus adaptées, le traitement est presque 10 fois plus rapide.

FichierTest.zip

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

rebcao: Je suis heureux que (gile) soit passé par là, comme cela a été rappelé l’algorithme "naïf" que j’avais proposé n’est pas très efficient dans le cas de gros traitement, hélas dans le temps que je m’étais fixé, je ne savais coder l’algorithme diviser pour régner… Donc sur ce point je n’ai pas de regret. ;)

 

(gile): Merci pour le source, à l’occasion je regarderai un peu plus dans détail, je suis persuadé que je ne l’aurai pas écrit aussi brillamment. Merci également d’avoir pris la peine de reposer clairement la problématique de départ, notamment cette remarque: …quel que soit le nombre de superpositions et le sens des lignes, sur ce coup-là je me déçois d’être passé au travers de cette réflexion (vis-à-vis du code proposé à rebcao), et je te remercie pour ce subtile rappel… :)

 

A+ Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Pour ceux qui lisent l'anglais, il y avait eu, sur TheSwamp, un challenge qui consistait, sur un fichier contenant 10000 points de relier entre eux par une ligne tous ceux qui étaient distants de 70 unités ou moins.

Ce challenge m'avait montré l'importance de l'optimisation algorithmique par rapport à celle de code (while est-il plus rapide que foreach ? par exemple).

 

Si on ne regarde que les implémentations en LISP (avec .NET ou ObjectARX/C++ il avait fallut assez vite passer à 100000 ou 1 million de points pour avoir des temps significatif), avec les premier jets, utilisant tous un algorithme naif commme celui décris ci-dessus, les temps d'exécution variaient entre 35 et 50 secondes suivant les optimisations des codes. Puis qjchen et ElpanovEvgeniy on commencé à optimiser les algorithmes d'abord en triant les points sur la coordonnées X, puis en X et Y et les temps d'exécutions sont descendus à 3 secondes puis 1.5 secondes pour finalement passer en dessous de la seconde.

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites

Pour ceux qui lisent l'anglais, il y avait eu, sur TheSwamp, un challenge qui consistait, sur un fichier contenant 10000 points de relier entre eux par une ligne tous ceux qui étaient distants de 70 unités ou moins.

Ce challenge m'avait montré l'importance de l'optimisation algorithmique par rapport à celle de code (while est-il plus rapide que foreach ? par exemple).

 

Si on ne regarde que les implémentations en LISP (avec .NET ou ObjectARX/C++ il avait fallut assez vite passer à 100000 ou 1 million de points pour avoir des temps significatif), avec les premier jets, utilisant tous un algorithme naif commme celui décris ci-dessus, les temps d'exécution variaient entre 35 et 50 secondes suivant les optimisations des codes. Puis qjchen et ElpanovEvgeniy on commencé à optimiser les algorithmes d'abord en triant les points sur la coordonnées X, puis en X et Y et les temps d'exécutions sont descendus à 3 secondes puis 1.5 secondes pour finalement passer en dessous de la seconde.

 

Salut,

Je suis heureux que vous avez apprécié mon approche de la programmation! smile.gif

Evgeniy

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

Pour faire suite à ce qu’il a été dit précédemment sur les algorithmes et pour satisfaire ma curiosité personnel, une meilleur version (même dans le cas extrême ou il n’y aurait que des lignes superposées) (Edit: Une autre version).

 

L’idée de base étant d’orienter toutes les lignes dans le même sens, puis de les trier suivants l’ensemble de leurs coordonnées de façon à sous-traiter l’intégralité de l’optimisation du traitement à la fonction lisp vl-sort.

 

(defun c:compare2 (/ ss i lst e elst pt1 pt2 flag)
 ;; prédicat d'infériorité de deux listes numériques
 (defun l1<l2-p (l1 l2)
   (if (and l1 (equal (car l1) (car l2)))
     (l1<l2-p (cdr l1) (cdr l2))
     (< (car l1) (car l2))
   )
 )
 (setq t0 (* 84600 (getvar 'tdusrtimer)))
 (and ;; sélection
      (setq ss (ssget "_X" '((0 . "LINE"))))
      ;; boucle
      (repeat (setq i (sslength ss))
        ;; extraction des données
        (setq e    (ssname ss (setq i (1- i)))
              elst (entget e)
              pt1  (cdr (assoc 10 elst))
              pt2  (cdr (assoc 11 elst))
        )
        ;; définie une liste de sous liste de coordonnées orientés 
        ;; format (((xa ya za xb yb zb) . <ename>) ...)
        (if (l1<l2-p pt1 pt2)
          (setq lst (cons (cons (append pt1 pt2) e) lst))
          (setq lst (cons (cons (append pt2 pt1) e) lst))
        )
      )
 )
 ;; trie en fonction des sous listes de cordonnées
 (setq lst (vl-sort lst '(lambda (a B) (l1<l2-p (car a) (car B)))))
 ;; suppression des lignes supperposées (coordonnées identique)
 (while (setq flag nil
              elst (car lst)
              lst  (cdr lst)
        )
   (while (equal (car elst) (caar lst))
     (entdel (cdar lst))
     (setq flag T
           lst  (cdr lst)
     )
   )
   (if flag
     (entdel (cdr elst))
   )
 )
 (setq t1 (* 84600 (getvar 'tdusrtimer)))
 (princ (strcat "\nTemps d'exécution : " (rtos (- t1 t0)) " secondes"))
 (princ)
)

 

(Ps : (gile) Le fichier test que tu as posté n’étant pas compatible avec ma version d’AutoCAD, je n’ai pas su faire de comparaison avec ta version en .NET mais si ce dernier ne comportait qu’un faible pourcentage de lignes superposées, j’espère ne pas être trop loin derrière… :rolleyes: )

 

A+

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Salut Bruno,

 

J'ai modifié la version du fichier test en téléchargement (AutoCAD 2007).

Sur mon poste, avec ce fichier, ton dernier LISP est un tout petit peu plus lent que le mien mais rien à voir avec l'implémentation de "l'algorithme naif".

 

Concernant l'impémentation en .NET, j'ai fait de rapides tests avec le même algorithme : grouper les lignes par longueur pour traiter chaque groupe séparément.

Le gain de performance (outre celui inhérent à du code compilé par rapport à du code interprété) est dû à l'utilisation de collection plus efficientes que les liste chaînées du LISP.

 

La méthode classique, dans un style impératif, utilise un dictionnaire dont les clés sont les longueurs de ligne et les valeurs des listes de lignes de longueurs égales. Les dictionnaires s'utilisent un peu comme les listes d'associations mais en plus efficace : l'accès à une clé est direct (au lieu de parcourir la liste jusqu'à trouver la clé). Les listes .NET ne sont pas des listes chaînées, ce sont en fait des tableaux indéxé redimensionnables, là encore, l'accès à un indice est direct.

 

        [CommandMethod("COMPARE1", CommandFlags.Modal)]
       public void EraseDuplicatedCmd1()
       {
           Document doc = AcAp.DocumentManager.MdiActiveDocument;
           Database db = doc.Database;
           Editor ed = doc.Editor;

           System.Diagnostics.Stopwatch sw = new System.Diagnostics.Stopwatch();
           sw.Start();

           TypedValue[] filter = { new TypedValue(0, "LINE"), new TypedValue(410, "Model") };
           PromptSelectionResult psr = ed.SelectAll(new SelectionFilter(filter));
           if (psr.Status != PromptStatus.OK) return;

           using (Transaction tr = db.TransactionManager.StartTransaction())
           {
               Dictionary<double, List<Line>> groups = new Dictionary<double, List<Line>>();
               foreach (ObjectId id in psr.Value.GetObjectIds())
               {
                   Line line = (Line)tr.GetObject(id, OpenMode.ForRead);
                   double length = line.GetDistAtPoint(line.EndPoint);
                   if (groups.ContainsKey(length))
                       groups[length].Add(line);
                   else
                       groups.Add(length, new List<Line>() { line });
               }
               foreach (List<Line> lst in groups.Values)
               {
                   bool duplicated = false;
                   for (int i = 0; i < lst.Count; i++)
                   {
                       for (int j = i + 1; j < lst.Count; j++)
                       {
                           if (IsDuplicated(lst[i], lst[j]))
                           {
                               lst[j].UpgradeOpen();
                               lst[j].Erase();
                               lst.RemoveAt(j);
                               duplicated = true;
                               j--;
                           }
                       }
                       if (duplicated)
                       {
                           lst[i].UpgradeOpen();
                           lst[i].Erase();
                       }
                   }
               }
               tr.Commit();
           }

           sw.Stop();
           ed.WriteMessage("\nTemps d'exécution : {0} secondes\n", sw.ElapsedMilliseconds / 1000.0);
       }

       private bool IsDuplicated(Line l1, Line l2)
       {
           return
               (l1.StartPoint.IsEqualTo(l2.StartPoint) && l1.EndPoint.IsEqualTo(l2.EndPoint)) ||
               (l1.StartPoint.IsEqualTo(l2.EndPoint) && l1.EndPoint.IsEqualTo(l2.StartPoint));
       }

 

Une autre méthode utilise un style plus fonctionnel/déclaratif avec une requête Linq pour grouper les lignes par longueur et ne retenir que les lignes dupliquées. Elle est à peine moins rapide (environ 0.16 secondes contre 0.13 secondes) mais, à mon avis plus lisible et un plus concise (eh non, un code .NET n'est pas toujours deux fois plus long que l'équivalent en LISP...).

 

        [CommandMethod("COMPARE2", CommandFlags.Modal)]
       public void EraseDuplicatedCmd2()
       {
           Document doc = AcAp.DocumentManager.MdiActiveDocument;
           Database db = doc.Database;
           Editor ed = doc.Editor;

           System.Diagnostics.Stopwatch sw = new System.Diagnostics.Stopwatch();
           sw.Start();

           using (Transaction tr = db.TransactionManager.StartTransaction())
           {
               BlockTableRecord mSpace =
                   (BlockTableRecord)tr.GetObject(SymbolUtilityServices.GetBlockModelSpaceId(db), OpenMode.ForRead);
               RXClass lineClass = RXClass.GetClass(typeof(Line));

               Func<Line, Line, bool> duplicate = (l1, l2) => l1 != l2 &&
                       (l1.StartPoint.IsEqualTo(l2.StartPoint) && l1.EndPoint.IsEqualTo(l2.EndPoint) ||
                       l1.StartPoint.IsEqualTo(l2.EndPoint) && l1.EndPoint.IsEqualTo(l2.StartPoint));

               var dups = mSpace
                   .Cast<ObjectId>()
                   .Where(id => id.ObjectClass == lineClass)
                   .Select(id => (Line)tr.GetObject(id, OpenMode.ForRead))
                   .GroupBy(l => l.Length)
                   .SelectMany(grp => grp.Where(l1 => grp.Any(l2 => duplicate(l1, l2))));
               foreach (Line line in dups)
               {
                   line.UpgradeOpen();
                   line.Erase();
               }
               tr.Commit();
           }
           sw.Stop();
           ed.WriteMessage("\nTemps d'exécution : {0} secondes\n", sw.ElapsedMilliseconds / 1000.0);
       }

 

Ci-joint les Dlls :

EraseDuplicatedLines_17 pour AutoCAD 2007-2009 (uniquement Compare1)

EraseDuplicatedLines_18 pour AutoCAD 2010-2012

EraseDuplicatedLines_18 pour AutoCAD 2013-2014

EraseDuplicatedLines.zip

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Gilles,

 

Un grand merci... Je vois que tu t'éclates encore une fois !

 

Si l'on voulait faire la même chose pour les arcs ! Il n'y a pas de code 11... ce serait compliqué à adapter ?

 

Je te remercie

 

Christian

 

 

 

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger , des Outils AutoCAD...

cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

J'ai modifié la version du fichier test en téléchargement (AutoCAD 2007).

Sur mon poste, avec ce fichier, ton dernier LISP est un tout petit peu plus lent que le mien mais rien à voir avec l'implémentation de "l'algorithme naif".

Il me semble que tu as supprimé la version en téléchargement du fichier, ce n’est pas grave, j’ai compris l’erreur sur mes tests, ils étaient erronés car j’ai bêtement généré des lignes avec la commande réseau (donc avec une trop grande quantité de lignes de longueurs identiques ce qui pénalisait ton algorithme au détriment du mien).

 

Merci pour cette échange qui m’aura permis d’avoir de meilleurs repères en tête pour le traitement de cas similaire. Merci également pour la version de ta dll EraseDuplicatedLines_17.

 

 

Si l'on voulait faire la même chose pour les arcs ! Il n'y a pas de code 11... ce serait compliqué à adapter ?

Pour ce qui est des versions Lisp, il n’y a aucune difficulté majeure bien au contraire, pour adapter l’algorithme précédent proposé par (gile). On peut directement trier sur la valeur du rayon, puis comparer les centres, les angles de départ et les angles de fin des arcs de cercle de même rayon.

 

En repartant du code de (gile) cela devrait donner quelque chose comme ceci :

(defun c:comparearc (/ ss n ent elst cen ray angdep angfin lst sub dup toErase t0 t1)
 (setq t0 (* 84600 (getvar 'tdusrtimer)))
 (if (setq ss (ssget "_X" '((0 . "ARC"))))
   (progn ;; constitue une liste de sous liste de sous-liste pour chaque ligne
          ;; (rayon ename (startAng endAng Centre))
          (repeat (setq n (sslength ss))
            (setq ent    (ssname ss (setq n (1- n)))
                  elst   (entget ent)
                  cen    (cdr (assoc 10 elst))
                  ray    (cdr (assoc 40 elst))
                  angdep (cdr (assoc 50 elst))
                  angfin (cdr (assoc 51 elst))
                  lst    (cons (list ray ent (cons angdep (cons angfin cen))) lst)
            )
          )
          ;; trie la liste par rayon
          (setq lst (vl-sort lst (function (lambda (l1 l2) (< (car l1) (car l2))))))
          ;; boucle principale
          (while lst
            (setq ray (caar lst))
            ;; constitue une liste de ligne de longueurs égales
            (while (= ray (caar lst))
              (setq sub (cons (cdar lst) sub)
                    lst (cdr lst)
              )
            )
            ;; boucle sur la liste d'arc de même rayons pour chercher les arc superposées
            (while sub
              (foreach l (cdr sub)
                ;; évalue si deux arc sont superposées
                (if (equal (cadar sub) (cadr l)); 
                  (setq toErase (cons (car l) toErase)
                        sub     (vl-remove l sub)
                        dup     T
                  )
                )
              )
              (if dup
                (setq toErase (cons (caar sub) toErase))
              )
              (setq sub (cdr sub)
                    dup nil
              )
            )
          )
          ;; supprime toutes les lignes superposées
          (foreach l toErase (entdel l))
   )
 )
 (setq t1 (* 84600 (getvar 'tdusrtimer)))
 (princ (strcat "\nTemps d'exécution : " (rtos (- t1 t0)) " secondes"))
 (princ)
)

 

Et dans la foulé la variante sur mon code précèdent, qui consistait à sous-traiter l’ensemble du trie à la fonction vl-sort :

(defun c:compararc2 (/ ss i lst e elst cen ray angdep angfin flag t0 t1 l1<l2-p)
 ;; prédicat d'inférieurité de deux listes numériques
 (defun l1<l2-p (l1 l2)
   (if (and l1 (equal (car l1) (car l2)))
     (l1<l2-p (cdr l1) (cdr l2))
     (< (car l1) (car l2))
   )
 )
 (setq t0 (* 84600 (getvar 'tdusrtimer)))
 (and ;; sélection
      (setq ss (ssget "_X" '((0 . "ARC"))))
      ;; boucle
      (repeat (setq i (sslength ss))
        ;; extraction des données
        (setq e      (ssname ss (setq i (1- i)))
              elst   (entget e)
              cen    (cdr (assoc 10 elst))
              ray    (cdr (assoc 40 elst))
              angdep (cdr (assoc 50 elst))
              angfin (cdr (assoc 51 elst))
              ;; definie une liste de sous liste de coordonnées orienté 
              ;; format (((xcen ycen zcen ray angdep angfin) . <ename>) ...)
              lst    (cons (cons (append cen (list ray angdep angfin)) e) lst)
        )
      )
 )
 ;; trie en fonction des sous listes de cordonnées
 (setq lst (vl-sort lst '(lambda (a B) (l1<l2-p (car a) (car B)))))
 ;; suppression des lignes supperposées (coordonnées identique)
 (while (setq flag nil
              elst (car lst)
              lst  (cdr lst)
        )
   (while (equal (car elst) (caar lst))
     (entdel (cdar lst))
     (setq flag T
           lst  (cdr lst)
     )
   )
   (if flag
     (entdel (cdr elst))
   )
 )
 (setq t1 (* 84600 (getvar 'tdusrtimer)))
 (princ (strcat "\nTemps d'exécution : " (rtos (- t1 t0)) " secondes"))
 (princ)
)

 

Par contre si c’est pour adapter les codes en .net, je me vois dans l’obligation de passer mon tour… ;)

 

A+ Bruno

(Ps : J’espère que (gile) ne m’en voudra pas d’avoir répondu à sa place)

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

  • 7 ans après...

Bonjour,

Je cherche moi aussi à supprimer des doublons.

On m’a envoyé un fichier DWG issu de Revit, j’ai utilisé le lisp RB de Patrick pour mettre tous les éléments internes à l’ensemble des blocs sur le calque « 0 » et mettre leurs couleurs sur « Dubloc ».

Le problème est que certains blocs sont par exemple composés de plusieurs lignes qui se superposent et des lignes qui ont comme distance 0 sur les 3 axes. Un bloc, composé de 18 lignes, pourrait être constitué de seulement 6 ou 8 lignes.

Je voudrais donc avoir un lisp comme « RB » mais pour supprimer les doublons dans l’ensemble des blocs.

Cordialement

Renaud

Lien vers le commentaire
Partager sur d’autres sites

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 compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité