Supprimer sommet superposés par calque

[chris_mtp]

Bonjour à tous,

 

J'essaye de faire un lisp qui supprimerai les sommets supperposés des polylignes 2D et 3D en proposant un traitement des polylignes par calques et non de l'ensemble des polylignes d'un dessin d'un coup car parfois cela peut réserver des surprises comme la suppression de sommets inattendues.

 

Voici donc le lisp en question.

En utilisant deux lips de Gile, dcl GetLayers et lisp Clean poly, 'encore merci à gile pour deux merveilles

 

 (defun trunc (expr lst)
 (if (and lst
   (not (equal (car lst) expr))
     )
   (cons (car lst) (trunc expr (cdr lst)))
 )
)



(defun c:clean_polylayer (/ ss1 lst1 ent e_lst p_lst vtx1 vtx2)
(setq lst1 (getlayers "Calques à traiter séparément" nil nil))
(repeat (length lst1)
(setq ss1   (ssget "X" (list (cons 8 lst1))))


 (while (not
   (foreach ent lst1
 (setq e_lst (entget ent))
 (cond
   ((= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 40)
		  (= (car x) 41)
		  (= (car x) 42)
	      )
	    )
	   e_lst
	 )
   e_lst (vl-remove-if
	   '(lambda (x)
	      (member x p_lst)
	    )
	   e_lst
	 )
    )
    (if (= 1 (cdr (assoc 70 e_lst)))
      (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
 (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst))
				   (reverse p_lst)
			   )
		      )
	     )
 )
      )
    )
    (while p_lst
      (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
     p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
      )
    )
    (entmod e_lst)
   )
   ((and (= "POLYLINE" (cdr (assoc 0 e_lst)))
  (zerop (logand 240 (cdr (assoc 70 e_lst))))
    )
    (setq e_lst (cons e_lst nil)
   vtx1	 (entnext ent)
   vtx2	 (entnext vtx1)
    )
    (while (= (cdr (assoc 0 (entget vtx1))) "VERTEX")
      (if (= (cdr (assoc 0 (entget vtx2))) "SEQEND")
 (if
   (or (not
	 (equal	(assoc 10 (entget vtx1))
		(assoc 10 (last (reverse (cdr (reverse e_lst)))))
	 )
       )
       (zerop (logand 1 (cdr (assoc 70 (last e_lst)))))
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
 (if
   (not
     (equal (assoc 10 (entget vtx1)) (assoc 10 (entget vtx2)) 1e-9)
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
      )
      (setq vtx1 vtx2
     vtx2 (entnext vtx1)
      )
    )
    (setq e_lst (reverse (cons (entget vtx1) e_lst)))
    (entdel ent)
    (mapcar 'entmake e_lst)
   )
   (T (princ "\nEntité non valide."))
 )
)
   )
   )
 )
 (princ)
)

(defun getlayers (titre lst1 lst2 / toggle_column tmp file lay layers len dcl_id)

(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

(defun toggle_column (lst)
(apply 'strcat
(mapcar
(function
(lambda (x)
(strcat ":toggle{key="
(vl-prin1-to-string x)
";label="
(vl-prin1-to-string x)
";}"
)
)
)
lst
)
)
)

(setq tmp (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
)
(while (setq lay (tblnext "LAYER" (not lay)))
(setq layers (cons (cons (cdr (assoc 2 lay)) (cdr (assoc 62 lay))) layers))
)
(setq
l_layers layers
layers (vl-sort (mapcar 'car layers) '<)
len (length layers)
)
(write-line
(strcat
"GetLayers:dialog{label="
(cond (titre (vl-prin1-to-string titre))
("\"Choisir les calques\"")
)
";:boxed_row{:column{"
(cond
((< len 12) (toggle_column layers))
((< len 24)
(strcat (toggle_column (sublist layers 0 (/ len 2)))
"}:column{"
(toggle_column (sublist layers (/ len 2) nil))
)
)
((< len 45)
(strcat (toggle_column (sublist layers 0 (/ len 3)))
"}:column{"
(toggle_column (sublist layers (/ len 3) (/ len 3)))
"}:column{"
(toggle_column (sublist layers (* (/ len 3) 2) nil))
)
)
(T
(strcat (toggle_column (sublist layers 0 (/ len 4)))
"}:column{"
(toggle_column (sublist layers (/ len 4) (/ len 4)))
"}:column{"
(toggle_column (sublist layers (/ len 2) (/ len 4)))
"}:column{"
(toggle_column (sublist layers (* (/ len 4) 3) nil))
)
)
)
"}}spacer;ok_cancel;}"
)
file
)
(close file)
(setq dcl_id (load_dialog tmp))
(if (not (new_dialog "GetLayers" dcl_id))
(exit)
)
(foreach n lst1
(set_tile n "1")
)
(foreach n lst2
(mode_tile n 1)
)
(action_tile
"accept"
"(setq lst nil)
(foreach n layers
(if (= (get_tile n) \"1\")
(setq lst (cons n lst))))
(done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmp)
lst
)

 

J'ai un petit souci avec la partie surligné car je n'arrive pas à créer un jeu d'entité par calque et surtout de pouvoir traiter les poly une à une par calque.

 

Merci par avance de votre aide.

John. [Edité le 31/1/2009 par chris_mtp][Edité le 31/1/2009 par chris_mtp]

[chris_mtp]

J'ai modifié le lisp déposé avec ceux que j'ai pu faire mais j'ai le retour

; erreur: valeur de liste SSGET incorrecte

 

Ya un truc qui cloche dans ma sélection par calques mais je ne sais pas comment sélectionner seulement les polylignes 2D et 3D par calques ?

 

Merci par avance de votre aide.

John.

[chris_mtp]

Avant d'utiliser la boite de dialogue de Gile, j'ai essayé de simplifier de lisp en intégrant les deux lignes de code suivantes en début de lisp

(setq lay (getstring "\nEntrer le nom du calque à sélectionner : "))
(setq ss1   (ssget "X" (list (cons 0 "LWPOLYLINE,POLYLINE") (cons 8 lay))))  

 

mais j'ai une question

Est il possible de faire une liste de polyligne ou de Lwpolyligne ?

Puis de faire traiter ces entités une par une avec un repeat.

 

Merci par avance de votre aide.

John.

[chris_mtp]

C'est vrai que sans aucune réponse depuis le début de ce post, je vais bien comprendre et avancer.

 

Merci.

[(gile)]

Salut,

 

Désolé de n'avoir répondu plus tôt, mais il m'arrive (comme à d'autres) d'avoir d'autres occupations que CADxp...

 

Ya un truc qui cloche dans ma sélection par calques mais je ne sais pas comment sélectionner seulement les polylignes 2D et 3D par calques ?

 

Les filtres de sélection sont basés sur les codes de groupe DXF mais peuvent aussi utiliser

- une virgule pour séparer plusieurs chaînes :

'((0 . "ARC,CIRCLE)) filtre les arcs et les cercles

- des caractères génériques pour les chaînes :

'((0 . "*TEXT")) filtre les TEXT, MTEXT et RTEXT

- des tests relationnels sur les nombres :

'((0 . "CIRCLE") (-4 . "

- des opérateurs logiques (AND, OR, XOR, NOT) :

'((-4 . "

(0 . "LWPOLYLINE")

(8 . "0")

(-4 . "OR>"))

filtre les polylignes et les objets sur le calque "0".

La virgule et les caractères génériques sont équivalents à OR.

Aucun opérateur logique équivaut à AND.

 

Ces options peuvent bien sûr être combinées, pour sélectionner les polylignes et les polylignes 3d sur un calque déterminé.

Les objets POLYLINE constituent une grande famille d'entité (polylignes 2d "old style", polylignes 3d et maillages) qui se différencient par la valeur de leur code 70. Cette valeur est une somme de code binaire, les polylignes 3d son caractérisées par la valeur 8 (qui peut être ajouté à 1 i la polyligne est fermée). Il faut donc filtrer les objets de type POLYLINE qui contiennent le code binaire 8 dans le groupe 70 :

'((-4 . ""))

Donc, pour les polylignes et les polylignes 3d sur un calque déterminé (lay) :

(list (cons 8 lay)
     '(-4 . "      '(0 . "LWPOLYLINE")
     '(-4 . "      '(0 . "POLYLINE")
     '(-4 . "&")
     '(70 . 8)
     '(-4 . "AND>")
     '(-4 . "OR>")
)

 

Pour sélectionner aussi les polyligne 2d "old style" (caractérisées par les codes 2 et 4, mais aussi parfois 128) il est plus simple d'écarter les maillages (codes 16 + 32 + 64 = 112) :

 

(list (cons 8 lay)
     '(-4 . "      '(0 . "LWPOLYLINE")
     '(-4 . "      '(0 . "POLYLINE")
     (-4 . "      '(-4 . "&")
     '(70 . 112)
     '(-4 . "NOT>")
     '(-4 . "AND>")
     '(-4 . "OR>")
)

 

Est il possible de faire une liste de polyligne ou de Lwpolyligne ?

Puis de faire traiter ces entités une par une avec un repeat.

 

Je ne comprends pas la nécessité : pourquoi parcourir une première fois un jeu de sélection pour en faire une liste et ensuite parcourir la liste pour les objets qu'elle contient, au lieu de parcourir le jeu de sélection pour traiter directement les objets qu'il contient ?

[chris_mtp]

Merci Gile de ta réponse.

Voila ce que j'ai pu faire

 

(defun trunc (expr lst)
 (if (and lst
   (not (equal (car lst) expr))
     )
   (cons (car lst) (trunc expr (cdr lst)))
 )
)


(defun c:clean_poly (/ lay layers ss1 ent e_lst p_lst vtx1 vtx2)
(while (setq lay (tblnext "LAYER" (not lay)))
(setq layers (cons (cons (cdr (assoc 2 lay)) (cdr (assoc 62 lay))) layers)))
(setq layers (vl-sort (mapcar 'car layers) '<))
(setq d 0)
(repeat (length layers)
(setq lay (nth d layers))
(setq ss1   (list (cons 8 lay)
     '(-4 . "      '(0 . "LWPOLYLINE")
     '(-4 . "      '(0 . "POLYLINE")
     '(-4 . "&")
     '(70 . 8)
     '(-4 . "AND>")
     '(-4 . "OR>")
))

 
(while (not
   (setq ent (car (entsel "\nSélectionnez une polyligne: ")))
 )
 )
 (setq e_lst (entget ent))
 (cond
   ((= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 40)
		  (= (car x) 41)
		  (= (car x) 42)
	      )
	    )
	   e_lst
	 )
   e_lst (vl-remove-if
	   '(lambda (x)
	      (member x p_lst)
	    )
	   e_lst
	 )
    )
    (if (= 1 (cdr (assoc 70 e_lst)))
      (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
 (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst))
				   (reverse p_lst)
			   )
		      )
	     )
 )
      )
    )
    (while p_lst
      (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
     p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
      )
    )
    (entmod e_lst)
   )
   ((and (= "POLYLINE" (cdr (assoc 0 e_lst)))
  (zerop (logand 240 (cdr (assoc 70 e_lst))))
    )
    (setq e_lst (cons e_lst nil)
   vtx1	 (entnext ent)
   vtx2	 (entnext vtx1)
    )
    (while (= (cdr (assoc 0 (entget vtx1))) "VERTEX")
      (if (= (cdr (assoc 0 (entget vtx2))) "SEQEND")
 (if
   (or (not
	 (equal	(assoc 10 (entget vtx1))
		(assoc 10 (last (reverse (cdr (reverse e_lst)))))
	 )
       )
       (zerop (logand 1 (cdr (assoc 70 (last e_lst)))))
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
 (if
   (not
     (equal (assoc 10 (entget vtx1)) (assoc 10 (entget vtx2)) 1e-9)
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
      )
      (setq vtx1 vtx2
     vtx2 (entnext vtx1)
      )
    )
    (setq e_lst (reverse (cons (entget vtx1) e_lst)))
    (entdel ent)
    (mapcar 'entmake e_lst)
   )
   (T (princ "\nEntité non valide."))
 )
(setq d (+ d 1))
)
 (princ)
) 

 

Pourquoi j'ai voulu faire une première liste puis ensuite un jeu de sélection ?

Le lisp Clean_poly ne permet de sélectionner une seule entité à la fois d'ou mon idée de d'abord faire la liste des calques, puis la liste des poly 2D et 3D par calque puis enfin de traiter chaque entité une par une.

C'est le seul moyen que j'ai trouvé pour appliquer ce lisp à une sélection des entités par calques. Mais j'ai deux problèmes,

1-lorsque la sélection ss1 est nulle il faudrait que le repeat passe au calque suivant ?

2-Comment faire pour traiter les entités par calque une à une ?

 

Voila mes deux principaux problèmes.

Merci encore de ton aide.

John.

[(gile)]

OK, dans un cas comme ça, le mieux est de faire une sous routine à partir de c:clean_poly qui ne demande pas à l'utilisateur de choisir un objet, mais requiert l'objet (ENAME) comme argument.

 

;;; CleanPoly (gile)
;;; Supprime les sommets superposés d'une polyligne
;;;
;;; Argument : ENAME de la polyligne (tout type)
;;;
;;; Retour : ENAME de la polyligne ou nil (si la procédure échoue)

(defun cleanpoly (ent / e_lst p_lst vtx1 vtx2)
 (setq e_lst (entget ent))
 (cond
   ((= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 40)
		  (= (car x) 41)
		  (= (car x) 42)
	      )
	    )
	   e_lst
	 )
   e_lst (vl-remove-if
	   '(lambda (x)
	      (member x p_lst)
	    )
	   e_lst
	 )
    )
    (if (= 1 (cdr (assoc 70 e_lst)))
      (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
 (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst))
				   (reverse p_lst)
			   )
		      )
	     )
 )
      )
    )
    (while p_lst
      (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
     p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
      )
    )
    (entmod e_lst)
    ent
   )
   ((and (= "POLYLINE" (cdr (assoc 0 e_lst)))
  (zerop (logand 240 (cdr (assoc 70 e_lst))))
    )
    (setq e_lst (cons e_lst nil)
   vtx1	 (entnext ent)
   vtx2	 (entnext vtx1)
    )
    (while (= (cdr (assoc 0 (entget vtx1))) "VERTEX")
      (if (= (cdr (assoc 0 (entget vtx2))) "SEQEND")
 (if
   (or (not
	 (equal	(assoc 10 (entget vtx1))
		(assoc 10 (last (reverse (cdr (reverse e_lst)))))
	 )
       )
       (zerop (logand 1 (cdr (assoc 70 (last e_lst)))))
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
 (if
   (not
     (equal (assoc 10 (entget vtx1)) (assoc 10 (entget vtx2)) 1e-9)
   )
    (setq e_lst (cons (entget vtx1) e_lst))
 )
      )
      (setq vtx1 vtx2
     vtx2 (entnext vtx1)
      )
    )
    (setq e_lst (reverse (cons (entget vtx1) e_lst)))
    (entdel ent)
    (mapcar 'entmake e_lst)
    ent
   )
   (T nil)
 )
)

;;; TRUNC (gile)
;;; Retourne la liste tronquée à partir de la première occurrence
;;; de l'expression (liste complémentaire de celle retournée par MEMBER)

(defun trunc (expr lst)
 (if (and lst
   (not (equal (car lst) expr))
     )
   (cons (car lst) (trunc expr (cdr lst)))
 )
)

 

Cette routine peut être ensuite appelée par des LISP qui récupère une ou plusieurs entités par l'intermédiaire de l'utilisateur.

 

Pour une sélection unique :

 

(defun c:clean_poly (/ ent)
 (while (not
   (setq ent (car (entsel "\nSélectionnez une polyligne: ")))
 )
 )
 (or (cleanpoly ent) (princ "\nEntité non valide"))
 (princ)
)

 

Pour une sélection de tout le dessin (regarde l'utilisation de if pour s'assurer que le le jeu de sélection existe)

 

(defun c:CleanAllPoly (/ ss n)
 (if (setq ss (ssget "_X"
	      '((-4 . "			(0 . "LWPOLYLINE")
		(-4 . "			(0 . "POLYLINE")
		(-4 . "			(-4 . "&")
		(70 . 112)
		(-4 . "NOT>")
		(-4 . "AND>")
		(-4 . "OR>")
	       )
       )
     )
   (repeat (setq n (sslength ss))
     (CleanPoly (ssname ss (setq n (1- n))))
   )
 )
 (princ)
)

 

Pour une sélection par calques (utilise les routines lst2str et GetLayer qui doivent être chargées)

 

(defun c:CleanPolyByLayer (/ lays ss n)
 (if (and (setq lays (getLayers "Calques à traiter" nil nil))
   (setq ss (ssget "_X"
		   (list (cons 8 (lst2str lays ","))
			 '(-4 . "				 '(0 . "LWPOLYLINE")
			 '(-4 . "				 '(0 . "POLYLINE")
			 '(-4 . "				 '(-4 . "&")
			 '(70 . 112)
			 '(-4 . "NOT>")
			 '(-4 . "AND>")
			 '(-4 . "OR>")
		   )
	    )
   )
     )
   (repeat (setq n (sslength ss))
     (CleanPoly (ssname ss (setq n (1- n))))
   )
 )
 (princ)
)

;; lst2str
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur
;;
;; Exemples
;; (lst2str '(1 2 3) ",") -> "1,2,3"
;; (lst2str '("a" "b" "c") " ") -> "a b c"

(defun lst2str (lst sep)
 (if (cadr lst)
   (strcat (vl-princ-to-string (car lst))
    sep
    (lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

[chris_mtp]

C'est vrai que vu comme ca, c'est plus facile de traiter les entités.

J'avais essayer d'utiliser le if après la sélection et chaque fois le lîsp ne voulait pas aller au bout.

Maintenant j'ai compris.

Merci Gile.

 

John.