Renommer certains calques

[charlie69]

Bonjour,

 

J’ai créé un LISP pour renommer certains calques.

 

FIS02ID09 -> FISID09

 

REAID09-> OBSID09

 

DIVERS09-> DIVERSID09

 

PHOID09 -> PHID09

 

Le LISPmarche pas trop mal et puis à un moment il plante car je me suis rendu compted’un doublon dans les calques.

 

En Effet, Il va renommer le calque ECID14 en DIVERSID14. Ce quifait que lorsque le LISP veut renommer le LISP DIVERS14 en DIVERSID14 le programmeplante car il y a un doublon. Je ne comprends pas d’où vient le problème.Pourtant, les espions que j’ai positionné me renvoient la bonne valeur.

Si vous avez une idée je suis preneur.

Voici le LISP en question, désolé je n'arrive pas à le mettre en pièce jointe ça me mets une erreur du coups je ne peux pas joindre le DWG pour aider :

 

(defun c:bonannee ()

(setvar "cmdecho" 0)

 

(setq typdefaut "0")

 

(setq calque (tblnext "layer" 1))

 

(while calque

;;sélection de l'entité calque

(setq nom (nth 1 calque))

;;sélection du nom du calque

(setq nomcalque (cdr nom))

(if

(<= (strlen nomcalque) 3) ""

(setq idannee (substr nomcalque (-(strlen nomcalque) 3)))

)

 

(cond

((<= (strlen nomcalque) 3) "")

((= (strlen nomcalque) 7) (setq typdefaut (substr nomcalque 1 (- (strlen nomcalque) 4)))) ;;;calques ayant 7 caractères

((= (strlen nomcalque) 8) (setq typdefaut (substr nomcalque 1 (- (strlen nomcalque) 2)))) ;;;calques ayant 8 caractères

((= (strlen nomcalque) 9) (setq typdefaut (substr nomcalque 1 (- (strlen nomcalque) 4)))) ;;;calques ayant 9 caractères

)

 

(if (= "PHO" typdefaut) ;;;calques avec 7 caractères

(command "renommer"

"ca"

nomcalque

(strcat "PH"

idannee

)

)

)

 

(if (= "REA" typdefaut) ;;;calques avec 7 caractères

(command "renommer"

"ca"

nomcalque

(strcat "OBS"

idannee

)

)

)

 

(if (= "FIS02" typdefaut) ;;;calques avec 9 caractères

(command "renommer"

"ca"

nomcalque

(strcat "FIS"

idannee

)

)

)

 

(if (= "DIVERS" typdefaut)

(command "renommer"

"ca"

nomcalque

(strcat "DIVERSID"

(substr nomcalque (- (strlen nomcalque) 1))

)

)

""

)

 

(setq calque (tblnext "layer"))

)

(setvar "cmdecho" 1)

)

 

 

Merci d'avance.

[zebulon_]

Bonjour,

un cond à la place de la série de if serait déjà mieux

amicalement

Vincent

[Invité eklundh80]

Salut,

 

Avant de renommer le calque, ne faudrait-il pas vérifier si le nouveau nom n'existe pas déjà?

 

(if (not (tblsearch "LAYER" "nouveau_nom"))
 ;;suite du programme 

[bseb67]

Salut,

 

Avant de renommer un calque, il faut t'assurer que le nouveau nom n'est pas déjà pris :

Tu peux utiliser (tblsearch "LAYER" sLayerNewName) où sLayerNewName est un string contenant ton nouveau nom.

 

Pour ma part, j'utulise plutôt du "vl" que "commande".

 

(defun calque_renommer_calque( sLayerOldName sLayerNewName / bRes vlaLayerOld)

; retour, par défaut erreur donc nil

(setq bRes nil)

 

(vl-load-com)

 

(cond

; on teste les paramètre

((/= (type sLayerOldName) 'STR)

)

((/= (type sLayerNewName) 'STR)

)

 

; on teste si le nouveau est déjà pris

((/= (tblsearch "LAYER" sLayerNewName) nil)

; nom déjà pris

)

 

; on récupère l'objet vla du calque

((= (tblsearch "LAYER" sLayerOldName) nil)

; l'ancien n'existe pas

)

((= (setq vlaLayerOld (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) sLayerOldName)) nil)

)

 

; on peut renommer le calque

((= (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Name (list vlaLayerOld sLayerNewName))) t)

)

 

(t

(setq bRes t)

) ; t

) ; cond

 

 

bRes

) ; calque_renommer_calque

 

 

PS : je laisse tomber avec CADXP, je ne sais pas si c'est seulement chez moi, mais j'ai perdu à nouveau plusieurs fois mon message !!! Et ça rame comme tout.

[charlie69]

Bonjour,

 

Merci pourvos réponses. Il m'est arrivé de perdre des messages mais surtout je ne peuxmettre aucune pièce jointe donc c'est embêtant. Avez-vous le même problème?

 

Je n'aijamais utilisé les "vl" contrairement à toi bseb67 du coup je ne suispas forcement à l'aise. Je trouve cela plus complexe.

 

Lorsque ceLISP est lancé le nom des nouveaux calques ne sont pas censés exister. Une foisutilisé cette routine ne sera plus utilisée.

 

Effectivement,si les calques sont déjà présents cela stoppe le LISP. C'est une bonne idée.

 

Doit-onfaire une boucle de comptage (sachant que les deux derniers chiffres du calquereprésentent une année) avec les deux derniers chiffres des calques?

 

Pour information l'erreur de doublon avec le calque DIVERSID(xx) ne vient pas du fait que celui-ci avait été déjà créé mais parce que le LISP renomme un autre calque. Je ne comprends pas d'où vient le problème. Avez-vous des méthodes pour détecter ce genre d'erreur?

 

 

 

 

[DenisHen]

Salut à tous.

 

je ne sais pas si j'ai bien compris. J'ai un bout de code qui, je pense, pourrait te convenir.

 

Bien sur, il ne fait pas la totalité de ton code, mais tu peut t'en inspirer.

 

Je trouve la liste de paires pointés très utile dans ce cas.

 

;;; ************************************************************
;;; Exemple de gestion des calques, existants et/ou nouveaux    
;;; ************************************************************
(defun c:GestCalq (/ LstCalq PosLst)
 (setq LstCalq '(("AncienNom01" . "NouveauNom01")
                 ("AncienNom02" . "NouveauNom02")
                 ;; Et ainsi de suite...
                )
 ) ;_ Fin de setq
 (princ "\nRemplacement / fusion des calques...")
 (foreach PosLst LstCalq
   (if (tblsearch "layer" (car PosLst))
     (progn (if (not (tblsearch "layer" (cdr (assoc (car PosLst) LstCalq))))
              (command "-calque" "n" (cdr (assoc (car PosLst) LstCalq)) "")
            ) ;_ Fin de if
            (command "fuscalques" "n" (car PosLst) "" "n" (cdr (assoc (car PosLst) LstCalq)) "o") ;_ Fin de command
     ) ;_ Fin de progn
   ) ;_ Fin de if
 ) ;_ Fin de foreach
 (princ)
) ;_ Fin de defun

[charlie69]

Après je ne sais pas si mes propos sont clairs... je vais essayer de reformuler tout ça.

Voici la liste des anciens calques dont certains devront être renommer (liste non exhaustive car il peut y avoir un certain nombre d'années antérieure) :

 

Nom Couleur

0 blanc

AAPID14 blanc

CALID09 bleu

CALID14 cyan

DEFPOINTS blanc

DES blanc

DIVERS09 blanc

DIVERS14 blanc

ECID09 bleu

ECID14 cyan

FIS01ID09 blanc

FIS01ID14 rouge

FIS02ID09 blanc

FIS02ID14 magenta

PHOID14 rouge

PRID14 blanc

REAID09 75

REAID10 vert

REAID14 vert

 

Les calques commençant par "FIS02" devront se commencer par "FIS"

Les calques commençant par "REA" devront se commencer par "OBS"

Les calques commençant par "PHO" devront se commencer par "PH"

Pour les calques DIVERS(xx), xx étant l'année, ceux-ci devront se nommer DIVERSID(xx)

Et ceci pour toutes les années.

 

Je vais m'inspirer de ce que vous m'avez envoyer et voir ce que ça donne.

Merci.

[Matt666]

Un truc comme ça ?

 

(defun c:test ( / l s)
(setq l 
	(list 
		'("FIS02" "FIS")
		'("REA" "OBS")
		'("PHO" "PH")
		'("DIVERS" "DIVERSID")
	)
)
(foreach pt (ai_table "layer" 0)
	(foreach elt l
		(if (vl-position (strcase (substr pt 1 (strlen (car elt)))) (mapcar 'car l))
			(progn
				(setq s (strcat (last elt) (substr pt (1+ (strlen (car elt))))))
				(if (tblsearch "layer" s)
					(princ (strcat "\nCalque '" s "' existant."))
					(progn
						(entmod (subst (cons 2 s)(cons 2 pt)(entget (tblobjname "layer" pt))))
						(princ (strcat "\nCalque '" pt "' renommé en '" s "'."))
					)
				)
			)
		)
	)
)
(princ)
)

 

[charlie69]

Bonjour,

J'ai repris la routine de DenisHen et j'ai créé une liste des calques qui m’intéressaient comme ce qu'il y a ci-dessous :

(setq LstCalq '(("AncienNom01" . "NouveauNom01")

("AncienNom02" . "NouveauNom02")

;; Et ainsi de suite...

)

 

Voici la liste des calques de base qu'il y a dans mon dessin :

 

0

AAPID14

CALID09

CALID14

DEFPOINTS

DES

DIVERS09

DIVERS14

ECID09

ECID14

FIS01ID09

FIS01ID14

FIS02ID09

FIS02ID14

PHOID14

PRID14

REAID09

REAID10

REAID14

 

Tout ce passe bien. Les calques sont bien renommés.Sauf que le LISP change la couleur des calques renommés. Je pense qu'il utilise la couleur du calque "0".

Je ne comprends pas d'où ça vient. Avez vous des idées?

 

Voici la routine que j'ai complété :

 

;;; ************************************************************

;;; Exemple de gestion des calques, existants et/ou nouveaux

;;; ************************************************************

(defun c:GestCalq (/ calq LstCalqOBS LstCalqFIS LstCalqPH LstCalqDIVERS LstCalq PosLst)

 

(setq calq (tblnext "LAYER" T))

 

(while calq

(setq LstCalq (cons (cdr (assoc 2 calq)) LstCalq)

calq (tblnext "LAYER")

)

)

 

(while LstCalq

(if (> (strlen (car LstCalq)) 3)

(cond

 

((= "REA" (substr (car LstCalq) 1 (-(strlen (car LstCalq)) 4))) (setq LstCalqOBS (cons (cons (car LstCalq) (strcat "OBS" (substr (car LstCalq) (-(strlen (car LstCalq)) 3)))) LstCalqOBS))

)

((= "FIS02" (substr (car LstCalq) 1 (-(strlen (car LstCalq)) 4))) (setq LstCalqFIS (cons (cons (car LstCalq) (strcat "FIS" (substr (car LstCalq) (-(strlen (car LstCalq)) 3)))) LstCalqFIS))

)

((= "PHO" (substr (car LstCalq) 1 (-(strlen (car LstCalq)) 4))) (setq LstCalqPH (cons (cons (car LstCalq) (strcat "PH" (substr (car LstCalq) (-(strlen (car LstCalq)) 3)))) LstCalqPH))

)

((= "DIVERS" (substr (car LstCalq) 1 (-(strlen (car LstCalq)) 2))) (setq LstCalqDIVERS (cons (cons (car LstCalq) (strcat "DIVERSID" (substr (car LstCalq) (-(strlen (car LstCalq)) 1)))) LstCalqDIVERS))

)

) ;fin cond

) ;fin if

(setq LstCalq (cdr LstCalq))

) ;fin While

 

(setq LstCalq (append (append (append LstCalqOBS LstCalqFIS) LstCalqPH) LstCalqDIVERS))

;;; (("REAID09" . "OBSID09") ("REAID14" . "OBSID14") ("REAID10" . "OBSID10") ("FIS02ID09" . "FISID09") ("FIS02ID14" . "FISID14") ("PHOID14" . "PHID14") ("DIVERS09" . "DIVERSID09") ("DIVERS14" . "DIVERSID14"))

 

;;; (setq LstCalq '(("AncienNom01" . "NouveauNom01")

;;; ("AncienNom02" . "NouveauNom02")

;;; ;; Et ainsi de suite...

;;; )

;;; ) ;_ Fin de setq

(princ "\nRemplacement / fusion des calques...")

(foreach PosLst LstCalq

(if (tblsearch "layer" (car PosLst))

(progn (if (not (tblsearch "layer" (cdr (assoc (car PosLst) LstCalq))))

(command "-calque" "n" (cdr (assoc (car PosLst) LstCalq)) "")

) ;_ Fin de if

(command "fuscalques" "n" (car PosLst) "" "n" (cdr (assoc (car PosLst) LstCalq)) "o") ;_ Fin de command

) ;_ Fin de progn

) ;_ Fin de if

) ;_ Fin de foreach

(princ)

) ;_ Fin de defun

 

 

*******************************************************************************************************************

 

Merci d'avance.

[DenisHen]

Salut.

 

Normalement, ma routine ne change pas la couleur du calque existant. Si le calque existe, c'est ok, il garde sa couleur, par contre, si le calque n'existe pas, la couleur sera le blanc...

 

Par contre, si tu as déjà un "gabarit" ou un DWG modèle, tu peut utiliser la commande Steal de Lee Mac...