Routine: Modifs de Texte + Prefixe

[lecrabe]

 

Hello les Pros

 

SVP pour de l'habillage de plans de cartographie / cadastre,

j'aurais besoin d'écrire un texte (simple) qui serait sur le calque courant, dans le style courant:

 

- Un Préfix éventuel, que l'on demande + le contenu du texte existant sélectionné (Sélection de N textes en fait) avec une normalisation numérique sur 4 cars, je m'explique:

 

Soit un No de Parcelle: 1, 23, 456, 3214

Il doit devenir: 0001, 0023, 02456, 3214

 

Auquel sera ajouté EVENTUELLEMENT le préfice saisi en début de routine:

par exemple: A, AB, 159A, 159BC, 92789000159E, 92789000EF

(Une chaine de N cars en fait)

 

Ainsi je disposerai d'un nouveau texte qui serait l'Identifiant (Unique plus ou moins complet) d'une parcelle en France alors que le DWG d'origine (1 section cadastrale) contient simplement un texte qui est le No de Parcelle sur 1-4 cars !

 

J'espère que je me suis bien exprimé ...

 

La fonction recherche / remplacement ne permet pas l'ajout de préfixe / suffixe (Ou alors je ne sais pas faire !) et quant à la normalisation sur N cars ...

 

Ainsi je sélectionne les 300 textes de No de Parcelle puis j'indique le préfixe éventuel et j'obtiens 300 NOUVEAUx textes qui sont les Identifiants de Parcelle plus ou moins complets (On ne touche pas aux textes d'origine).

 

Le Decapode (vous remerciant par avance)

 

[bonuscad]

Essayes la proposition suivante, "ça devrait l' faire" bien que je n'ai pas testé en profondeur. ;)

 

(defun cv_str (alpha / nb nw_car carac)
(setq nb 1 nw_car "")
(while (> (strlen alpha) 0)
	(cond
		((wcmatch alpha "*',*")
			(while (and (/= (substr alpha nb 1) ",") (<= nb (strlen alpha)))
				(setq nb (1+ nb))
			)
			(setq carac (substr (rtos (* 0.0001 (read (substr alpha 1 (1- nb)))) 2 4) 3))
			(setq nw_car (strcat nw_car (if (/= nw_car "") ","  "") carac))
			(setq alpha (substr alpha (1+ nb)))
		)
	)
	(setq nb 1)
)
(setq a nw_car)
)
(defun c:re-index ( / ent dxf_ent nw_pt ang lg flag prfx js n)
(while (not (setq ent (entsel "\nChoisir un texte: "))))
(cond
	((eq (cdr (assoc 0 (setq dxf_ent (entget (car ent))))) "TEXT")
		(setq
			nw_pt (trans (getpoint (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) "\nPosition relative pour le nouveau texte?: ") 1 (car ent))
			ang (angle (cdr (assoc 10 dxf_ent)) nw_pt)
			lg (distance (cdr (assoc 10 dxf_ent)) nw_pt)
		)
		(initget "Oui Non _Yes No")
		(if (eq (getkword "\nAjouter un prefix [Oui/Non]? < Non >: ") "Yes") (setq flag T) (setq flag nil))
		(if flag (setq prfx (getstring T "\nEntrez le préfixe souhaité?: ")))
		(setq js (ssget "_X" (list (assoc 0 dxf_ent) (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent))) n -1)
		(while (setq ent (ssname js (setq n (1+ n))))
			(setq dxf_ent (entget ent))
			(entmake
				(list
					(cons 0 "TEXT")
					(cons 100 "AcDbEntity")
					(assoc 67 dxf_ent)
					(assoc 410 dxf_ent)
					(cons 8 (getvar "CLAYER"))
					(cons 100 "AcDbText")
					(cons 10 (polar (cdr (assoc 10 dxf_ent)) ang lg))
					(assoc 40 dxf_ent)
					(cons 1 (if flag (strcat prfx (cv_str (cdr (assoc 1 dxf_ent)))) (cv_str (cdr (assoc 1 dxf_ent)))))
					(assoc 50 dxf_ent)
					(assoc 41 dxf_ent)
					(assoc 51 dxf_ent)
					(cons 7 (getvar "TEXTSTYLE"))
					(assoc 71 dxf_ent)
					(assoc 72 dxf_ent)
					(assoc 11 dxf_ent)
					(assoc 210 dxf_ent)
					(cons 100 "AcDbText")
					(assoc 73 dxf_ent)
				)
			)
		)
	)
	(T
		(princ "\nCe n'est pas un texte!")
	)
)
(prin1)
)

[lecrabe]

 

Bon Matin Maître Bonuscad

 

Mille Mercis ... Ta routine est presque parfaite !

 

Je montre un éventuel décalage pour placer le texte mais cela ne fonctionne pas !

C'est pas grave, car ta routine Re-Ecrit le nouveau texte exactement par dessus l'ancien

et c'est très bien comme ça !

 

Par contre ta routine sélectionne tous les textes et j'aimerais bien pouvoir faire une sélection "normale": c'est à dire à la main ou bien taper l'option "TOUT / _ALL" !?

 

SVP est ce possible d'avoir une petite modif oh divin grand Prête du Lisp, V-Lisp, etc ?

 

Le Decapode "admiratif de ta rapidite de reaction"

 

[bonuscad]

Bonjour à toi "Ho Décapode!"

 

Je montre un éventuel décalage pour placer le texte mais cela ne fonctionne pas !

Bizzare cela fonctionne chez moi! :(

N'as tu pas le mode "insertion" actif pour l'accroche objet lors de la demande du point relatif, car je ne vois que ça qui pourrait expliquer ce comportement.

 

Par contre ta routine sélectionne tous les textes et j'aimerais bien pouvoir faire une sélection "normale": c'est à dire à la main ou bien taper l'option "TOUT / _ALL" !?

 

Très simple tu remplaces:

(setq js (ssget "_X" (list (assoc 0 dxf_ent) (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent))) n -1)

 

par

 

(initget "Tous Sélection _All Select")

(if (eq (getkword "\nChoix des textes filtrés par le modèle? [Tous/Sélection] < Sélection >: ") "All")

(setq js (ssget "_X" (list (assoc 0 dxf_ent) (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent))) n -1)

(setq js (ssget (list (assoc 0 dxf_ent) (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent))) n -1)

)

[lecrabe]

 

Bon Matin

 

La routine est Tip-Top maintenant, merci beaucoup ! :)

 

Cependant avec mon AutoCAD 2004, le deplacement relatif de la position du nouveau texte ne fonctionne pas ...

 

C'est pas grave, mais il faudra que je fasse un essai avec un AutoCAD 2005 / 2006 / 2007

pour voir si c'est lié à la version d'AutoCAD !? :casstet:

 

Thanks Mr Bonuscad, Le Decapode

 

[lecrabe]

 

Bon Matin

 

Oh Grand Maitre Bonuscad, je viens de m'apercevoir que ta routine a un petit bug "subtil" !

 

Elle normalise bien avec des ZEROs à gauche une valeur numérique sur 4 chiffres

avec en plus un éventuel préfixe

MAIS si le chiffre de départ finit par un ou plusieurs ZEROs, ça "déconne" un peu ! :o

 

1 ==> 0001 = OK

10 ==> 001 = NOK

100 ==> 01 = NOK

1000 ==> 1 = NOK

 

En espérant une correction, je te souhaite une bonne journée :)

Le Decapode

 

 

[bonuscad]

Bonjour,

 

Je pense que cela vient de la valeur de la variable "DIMZIN", sa valeur doit être à 8 ou 12 pour produire ce résultat !

 

Soit tu la fixe avant utilisation du lisp (< 4), soit tu rajoutes quelques lignes de code pour la fixer temporairement dans le lisp et la restorer en fin de procédure (pour ne pas mettre le bazar dans la cotation après une mise à jour...de celle-ci).

[lecrabe]

 

Hello

 

Et OUI, tu as parfaitement raison ! :)

 

Ta routine fonctionne parfaitement avec DIMZIN = ZERO

qui influe sur les fonctions RTOS et ANGTOS

 

Je suis NUL ou plutot c'est l'age qui frappe encore ... :(

car je connais bien ce DIMZIN et son influence sur les cotations :P

 

Encore merci à toi, Le Decapode

 

[xavier91]

bonjour

 

je viens de transcrire le lisp mais je ne suis pas un pro.......donc il ne marche pas....

pourriez vous m'indiquer ou je peux le trouver déja construit pour que je puisse le comparer à celui que j'ai pour trouvez mais erreurssssssssss, c'est peut etre très simple pour vous mais pour moi qui débute....

merci beaucoup

[lecrabe]

 

Hello

 

Tu m'ecris sur mon courriel et je te renvoie le Lisp ...

 

cadxp at hotmail.fr

 

Le Decapode