Joindre polyligne par calque

[LUDWIG]

Bonjour et bonne année à tous !

 

Mon problème du jour : quand je fais un Pedit multiple pour joindre différentes lignes/polylignes/... , j'obtiens un résultat abhérrant car autocad joint des entités de calques différents. Y-a-'il un moyen (variable, option) d'empêcher ce mélange (sans lancer la commande pour calque par calque) ?

 

Sinon, en lisp, j'ai ben l'algorithme en tête mais après ces vacances, j'a vraiment du mal à le faire :

1 - Sélection des objets à joindre

2 - Sélection des objets appartenant au calque suivant du jeu de sélection

3 - Commande Pedit - Multiple - Joindre - Type de jointure : prolonger - Distance 0

4 - retour à 2 (désolé je faisais du basic quand j'étais petit)

[Serge]

Ludwig,

 

 

(defun c:pedit2 (

/ fuzz hasLineOrArc i layer n objet oldPeditaccept peditaccept repere ss

)

(setq fuzz 0.0)

(setq repere (entsel"\nChoix de la polyligne, arc ou ligne à joindre: "))

(setq layer (cdr (assoc 8 (entget (car repere)))))

(setq ss (ssget (list (cons 0 "*polyline,arc,line") (cons 8 layer))))

(setq hasLineOrArc nil)

(setq i 0 n (if ss (sslength ss) 0))

(while (< i n)

(setq objet (ssname ss i))

(if (member (strcase (cdr (assoc 0 (entget objet))) t) '("arc" "line"))

(setq hasLineOrArc t i (1+ n))

)

(setq i (1+ i))

)

(cond

((not ss) nil)

((> (substr (getvar "acadver") 1 4) "16.1")

(setq oldPeditaccept (getvar "peditaccept"))

(setvar peditaccept 1)

(command "_pedit" "_multiple" ss "" "_join" fuzz "")

)

(hasLineOrArc (command "_pedit" "_multiple" ss "" "_yes" "_join" fuzz ""))

(t (command "_pedit" "_multiple" ss "" "_join" fuzz ""))

)

(princ)

)

(princ "\nTapez PEDIT2 pour joindre des objets d'un même calque.")

(princ)

 

 

Serge

 

[LUDWIG]

MERCI Serge mais ce n'est pas tout à fait ça que je recherche... En fait, la première sélection doit se faire sur plusieurs objets de calques différents, et le lisp doit joindre chaque objet calque par calque.

 

Exemple : un plan avec 300 lignes/polylignes calques "eau froide" ; 200 lignes/polylignes calques "eau chaude" ; 150 lignes/polylignes calques "eau usée". On lance la commande. On sélectionne l'ensemble des entités du dessin (ou juste une partie) et le lisp fait :

- Pedit/multiple/joindre sur les 300 lignes/polylignes calques "eau froide"

- Pedit/multiple/joindre sur les 200 lignes/polylignes calques "eau chaude"

- Pedit/multiple/joindre sur les 150 lignes/polylignes calques "eau usée".

En résumé, on a lancer qu'une fos la commande pour l'ensemble des calques et il n'y a pas de jointure de calque différents.

 

Euh... je sais pas si mes explications sont très claires ?

[bonuscad]

En reprenant le lisp de Serge et en incluant un parcours des calques.

C'est pas tout à fait ton souhait, mais presque (ssget "X") , sélection automatique par calque.

Tu peut essayer d'alméliorer encore un peu.

 

(defun c:pedit2 ( / fuzz hasLineOrArc i layer n objet oldPeditaccept peditaccept repere ss curr_layer next_layer name_layer)
(setvar "cmdecho" 0)
(setq fuzz 0.0)
(setq
	curr_layer (getvar "clayer")
	next_layer (tblnext "LAYER" T)
)
(if (setq next_layer (tblnext "LAYER"))
	(setq name_layer (cdr (assoc 2 next_layer)))
	(setq name_layer "0")
)
(while (/= curr_layer name_layer)
	(if (/= curr_layer name_layer)
		(progn
			(setq ss (ssget "_X" (list (cons 0 "*polyline,arc,line") (cons 8 name_layer))))
			(setq hasLineOrArc nil)
			(setq i 0 n (if ss (sslength ss) 0))
			(while (< i n)
				(setq objet (ssname ss i))
				(if (member (strcase (cdr (assoc 0 (entget objet))) t) '("arc" "line"))
					(setq hasLineOrArc t i (1+ n))
				)
				(setq i (1+ i))
			)
			(cond
				((not ss) nil)
				((> (substr (getvar "acadver") 1 4) "16.1")
					(setq oldPeditaccept (getvar "peditaccept"))
					(setvar peditaccept 1)
					(command "_.pedit" "_multiple" ss "" "_join" fuzz "")
				)
				(hasLineOrArc
					(command "_.pedit" "_multiple" ss "" "_yes" "_join" fuzz "")
				)
				(t
					(command "_.pedit" "_multiple" ss "" "_join" fuzz "")
				)
			)
		)
	)
	(setq next_layer (tblnext "LAYER"))
	(if (null next_layer)
		(setq next_layer (tblnext "LAYER" T))
	)
	(setq name_layer (cdr(assoc 2 next_layer)))
)
(setvar "cmdecho" 0)
(princ)
)
(princ "\nTapez PEDIT2 pour joindre des objets d'un même calque.")
(princ)

 

[Patrick_35]

Pour Serge

(cons 0 "*polyline,arc,line")

C'est encore une manière de faire un filtre que je ne connaissais pas, c'est comme sur ce lien. J'en apprends tous les jours, et c'est tant mieux.

 

@+

[Serge]

Ludwig,

 

Petite transfo. Je n'ai pas testé si le dessin contient des mailles polygonales ou des 3poly. Dans un tel cas, la commande pedit agit différemment et fera sans doute planter la routine. Il suffira alors d'élaborer le filtre.

 

 

(defun c:pedit2 (

/ fuzz hasLineOrArc i layer layer_ss1 layer_ss2 layer_sss n objet objetGet

oldPeditaccept peditaccept repere ss

)

(setq fuzz 0.0)

(setq ss (ssget (list (cons 0 "*polyline,arc,line")))) ; élaborer si on veut filtrer les mailles et 3dpoly

(setq hasLineOrArc nil)

(setq i 0)

(setq n (if ss (sslength ss) 0))

(setq layer_sss nil)

(while (< i n)

(setq objet (ssname ss i))

(setq objetGet (entget objet))

(setq hasLineOrArc (if (member (strcase (cdr (assoc 0 objetGet)) t) '("arc" "line")) t nil))

(setq layer (cdr (assoc 8 objetGet)))

(if (setq layer_ss1 (assoc layer layer_sss))

(progn

(setq layer_ss2 (list layer (ssadd objet (cadr layer_ss1)) (or hasLineOrArc (caddr layer_ss1))))

(setq layer_sss (subst layer_ss2 layer_ss1 layer_sss))

)

(progn

(setq layer_ss2 (list (list layer (ssadd objet (ssadd)) hasLineOrArc)))

(setq layer_sss (append layer_ss2 layer_sss))

))

(setq i (1+ i))

)

(while layer_sss

(setq layer_ss1 (car layer_sss))

(setq layer (car layer_ss1))

(setq ss (cadr layer_ss1))

(setq hasLineOrArc (caddr layer_ss1))

(princ (strcat "\n" (itoa (sslength ss)) " objets sélectionnés sur le calque '" layer "'."))

(cond

((not ss) nil)

((< (sslength ss) 2) nil) ; Au moins 2 segments requis

((> (substr (getvar "acadver") 1 4) "16.1")

(setq oldPeditaccept (getvar "peditaccept"))

(setvar peditaccept 1)

(command "_pedit" "_multiple" ss "" "_join" fuzz "")

)

(hasLineOrArc (command "_pedit" "_multiple" ss "" "_yes" "_join" fuzz ""))

(t (command "_pedit" "_multiple" ss "" "_join" fuzz ""))

)

(setq layer_sss (cdr layer_sss))

)

(princ)

)

 

 

Serge

 

[LUDWIG]

Merci à vous, Serge et BonusCAD !

 

Je n'ai pas réussi à fare fonctionner le programme de BonusCAD ("choix de l'option incorrect") et je n'ai pas vu d'où venait l'erreur.

 

Le programme de Serge fonctionne. Mais il doit y rester une toute petite erreur au niveau de la recherche de la version pour le "PEDITACCEPT" : il me lance la ligne de commande ou il y a la réponse "YES" alors qu'il devrait lancer la ligne de commande précédente (sans le "YES") car je suis sur Autodesk Architectural Desktop 2004 avec un "PEDITACCEPT" à 1... Est-ce que ces deux lignes ne sont pas simplement inversées ?

 

Merci les champions (vous faites quoi dans le vie pour être aussi calés en LISP ?)

[Serge]

Ludwig,

 

J'ai honte de ne pas avoir testé en 2005

 

Remplace (> (substr (getvar "acadver") 1 4) "16.1")

par (>= (substr (getvar "acadver") 1 4) "16.1")

 

Blame l'erreur sur Rio

 

Pour ce qui est de notre occupation du temps, je passe environ 20% de mon temps à programmer donc ça devient une routine :-)

 

Serge

[LUDWIG]

Il suffit de pas grand chose...

 

Bon, ça marche mais pas à tous les coups (juste 1 fois sur 10). Et je n'ai pas réussi à comprendre pourquoi ça marchait ou pas.

 

 Commande: pedit2

Choix des objets: Spécifiez le coin opposé: 153 trouvé(s)

Choix des objets:

55 objets sélectionnés sur le calque 'CV-TUY'._pedit Sélectionnez la polyligne 
ou [Multiple]: _multiple
Choix des objets:   55 trouvé(s)

Choix des objets:
Entrez une option 
[Clore/Ouvrir/Joindre/Epaiss/Lissage/sPline/Retrouver/Typeligne gén/Annuler]: 
_yes
Choix de l'option incorrect.

 

Mon ACADVER est 16.0s (LMS Tech). J'ai essayé de changé la ligne par

  (>= (substr (getvar "acadver") 1 4) "16. [b] 0[/b]")

mais ça ne marche pas (oui, je n'ai pas tout compris au programme mais j'ai bidouillé, quoi... j'ai au moins compris que le PEDITACCEPT n'existe pas dans les versions antérieurs à 16 d'ou la nécessité de faire 2 lignes de commandes différentes):

 

 Commande: pedit2

Choix des objets: Spécifiez le coin opposé: 153 trouvé(s)

Choix des objets:

5 objets sélectionnés sur le calque 'CV-CONDENSATS'.; erreur: type d'argument 
incorrect: (or stringp symbolp): nil

 

Je me demande... Tu fais une comparaison >= sur des chaînes de textes (acadver). Est-ce que ça vient pas de là ? Sinon, au contraire, peut-être imposer le PEDITACCEPT à 0 pour faire une ligne unique de commande (celle avec le "yes").

 

En tout cas merci de ta précieuse aide...

[Serge]

Ludwig,

 

Je vais vérifier plus tard mais je pense que c'est dû à la présence de 3dpoly ou de mailles, comme je l'avais signalé. Je filtrerai ces objets pour être sur.

 

Serge

 

[Serge]

Ludwig,

 

Me revoici. J'en ai profité pour rendre le code plus lisible.

 

;;; C:PEDIT2

;;; Permet de joindre des polylignes classées par calques

;;;

;;; Compatibilité: AutoCAD R13 et plus

;;;

;;; Instructions:

;;; 1) Charger ce fichier

;;; 2) Tapez PEDIT2 sur la ligne de commande

;;; 3) Choisissez des objets. Les objets invalides sont filtrés.

;;;

;;; Modifications:

;;; 2005/01/06 : Filtrer les mauvais objets.

;;;

;;; Par Serge Camiré, CadNovation, 2005/01/01

;;; http://www.cadnovation.com/fr

;;;

 

(defun c:pedit2 (

/ acadver fuzz hasLineOrArc i is3DpolylineOr3Dmesh layer n objet

objetGet oldPeditaccept ss triplet1 triplet2 triplets

)

(setq fuzz 0.0) ; tolerance pour joindre ou non

 

(setq acadver (substr (getvar "acadver") 1 4))

(if (>= acadver "16.1")

(progn

(setq oldPeditaccept (getvar "peditaccept"))

(setvar "peditaccept" 1)

))

 

(setq ss (ssget (list (cons 00 "*polyline,line,arc"))))

(setq hasLineOrArc nil)

(setq i 0)

(setq n (if ss (sslength ss) 0))

(setq triplets nil)

 

;; Construire autant de triplets que de calques, comme suit:

;; Triplet == (calque selection-set hasLineOrArc)

;; Filtrer les 3dPolyline et les 3DMesh

(while (< i n)

(setq objet (ssname ss i))

(setq objetGet (entget objet))

(setq hasLineOrArc (if (member (strcase (cdr (assoc 0 objetGet)) t) '("arc" "line")) t nil))

(setq layer (cdr (assoc 8 objetGet)))

(setq polylineFlag (cdr (assoc 70 objetGet)))

(setq is3DpolylineOr3Dmesh (and polylineFlag (> (boole 1 polylineFlag (+ 8 16)) 0)))

 

(cond

(is3DpolylineOr3Dmesh nil) ; Ignorer

((setq triplet1 (assoc layer triplets))

(setq triplet2 (list layer (ssadd objet (cadr triplet1)) (or hasLineOrArc (caddr triplet1))))

(setq triplets (subst triplet2 triplet1 triplets))

)

(t

(setq triplet2 (list (list layer (ssadd objet (ssadd)) hasLineOrArc)))

(setq triplets (append triplet2 triplets))

)

)

(setq i (1+ i))

)

 

;; Traiter un triplet après l'autre.

(foreach triplet1 triplets

(setq layer (car triplet1))

(setq ss (cadr triplet1))

(setq hasLineOrArc (caddr triplet1))

(princ (strcat "\n" (itoa (sslength ss)) " objets sélectionnés sur le calque '" layer "'."))

(cond

((not ss) nil)

((< (sslength ss) 2) nil) ; Au moins 2 segments requis

((>= acadver "16.1") ; peditaccept déjà fixé à 1

(command "_pedit" "_multiple" ss "" "_join" fuzz "")

)

(hasLineOrArc (command "_pedit" "_multiple" ss "" "_yes" "_join" fuzz ""))

(t (command "_pedit" "_multiple" ss "" "_join" fuzz ""))

)

)

 

(if (>= acadver "16.1") (setvar peditaccept oldPeditaccept))

(princ)

)

 

Serge

 

[LUDWIG]

Je crois que maintenant ça marche impec ! Merci encoe de ta générosité (et la générosité de tous les autres membres de CADxp). Un jour viendra, où c'est moi qui vous viendrais en aide (!)...