permutter des textes avec textes repere

[zin29]

salut

j' utilise ce lisp pour la permutation des textes et attributs et autre. Mais je commence a utiliser de plus en plus les lignes de reperes multiple . et ce lisp ne marche pas.

si quelqu'un a la solution pour la permutation de textes pour les lignes de repere je suis preneur.

merci

 

;;; Routines pour la gestion des textes.

;;; Par Kamal Boutora

;;; ----------

 

;;;

;;; fonction Text SWap, permet de permutter

;;; des textes, des attributs ou des mtextes.

 

 

(defun c:TSW(/ e1 e2 t1 t2 ine1 ine2)

(if (and (setq e1 (nentsel "\nSelectionnez le 1er texte"))

(setq e2 (nentsel "\nSelectionnez le 2eme texte")))

(progn

(setq ine1 (entget (car e1))

ine2 (entget (car e2)))

(setq t1 (cdr (assoc 1 ine1)))

(setq t2 (cdr (assoc 1 ine2)))

(if (and t1 t2)

(progn

(entmod (subst (cons 1 t2) (assoc 1 ine1) ine1))

(entmod (subst (cons 1 t1) (assoc 1 ine2) ine2))

(entupd (car e1))

(entupd (car e2))

)

(princ "\nErr, choisissez des textes")

)

)

(princ "\nCamarade, faut bien choisir :)"))

(princ)

)

 

(defun c:TCP(/ e1 e2 t1 t2 ine1 ine2)

(if (and (setq e1 (nentsel "\nSelectionnez le texte source"))

(setq e2 (nentsel "\nSelectionnez le texte destination")))

(progn

(setq ine1 (entget (car e1))

ine2 (entget (car e2)))

(setq t1 (cdr (assoc 1 ine1)))

(setq t2 (cdr (assoc 1 ine2)))

(if (and t1 t2)

(progn

(entmod (subst (cons 1 t1) (assoc 1 ine2) ine2))

(entupd (car e2))

)

(princ "\nErr, choisissez des textes")

)

)

(princ "\nCamarade, faut bien choisir :)"))

(princ)

)

 

 

 

;;; Insère la dernière surface en un point spécifié par l'utilisateur.

;;; surf_pfx: contient le préfixe à mettre avant la surface

;;; surf_sfx: contient le suffixe.

;;; Précision (nombre de décimales) selons réglages en cours.

 

(defun c:iSSS(/ pt surf_pfx surf_sfx)

 

(setq surf_pfx "S=") ;;; Préfixe pour les surfaces

(setq surf_sfx " m2") ;;; Suffixe

 

(if (setq pt (getpoint "\nEt on la met ou cette surface maintenant ? :"))

(entmake (list (cons 0 "TEXT")

(cons 10 pt)

(cons 1 (strcat surf_pfx (rtos (getvar "AREA")) surf_sfx))

(cons 40 (getvar "textsize"))

))

)

(princ)

)

 

;;;; Transformations en majuscules et miniscules d'un

;;;; Texte, de la valeur d'un attribut, ou de la valeur

;;;; par défaut d'un ATTDEF.

;;;; ------

 

 

 

 

(defun c:Minus(/ e ine )

;;; Sélection

(if (setq e (nentsel "\nSelectionnez un texte ou un attribut"))

(progn

;;; Prendre juste le nom de l'entité.

(setq e (car e) ine (entget e))

;;; Vérifier le type d'entité:

(cond

 

((or (= (cdr (assoc 0 ine)) "TEXT")

(= (cdr (assoc 0 ine)) "ATTRIB")

(= (cdr (assoc 0 ine)) "ATTDEF"))

(setq txt (cdr (assoc 1 ine)))

(setq ine (subst (cons 1 (strcase txt 'T)) (assoc 1 ine) ine))

(entmod ine)(entupd e)

)

(T

(princ "\nMauvaise selection, recommencez !")

)

)

))

(princ)

)

 

(defun c:Majus(/ e ine )

;;; Sélection

(if (setq e (nentsel "\nSelectionnez un texte ou un attribut"))

(progn

;;; Prendre juste le nom de l'entité.

(setq e (car e) ine (entget e))

;;; Vérifier le type d'entité:

(cond

 

((or (= (cdr (assoc 0 ine)) "TEXT")

(= (cdr (assoc 0 ine)) "ATTRIB")

(= (cdr (assoc 0 ine)) "ATTDEF"))

(setq txt (cdr (assoc 1 ine)))

(setq ine (subst (cons 1 (strcase txt nil)) (assoc 1 ine) ine))

(entmod ine)(entupd e)

)

(T

(princ "\nMauvaise selection, recommencez !")

)

)

))

(princ)

)

(princ "\nUtilisez Minus pour convertir en miniscules,\n Majus pour les majuscules \nTCP pour recopier des textes \nTSW pour permuter des textes \nIS pour insérer la dernière surface que vous venez de calculer")(princ)

 

[bonuscad]

Salut,

 

si quelqu'un a la solution pour la permutation de textes pour les lignes de repere je suis preneur.

 

Essayes ce qui suit, doit fonctionner normalement aussi avec entités imbriquées dans un bloc, à tester plus en profondeur...

 

(vl-load-com)
(defun c:swap_texte ( / AcDoc Space e1name e2name string1 string2)
(defun sel_onlyText (msg / js)
	(princ msg)
	(while
		(not
			(setq js
				(ssget "_+.:E:S:N" 
					(list
						(cons 0 "*TEXT,MULTILEADER,ATTRIB,INSERT")
						(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
						(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
					)
				)
			)
		)
	)
	(vlax-ename->vla-object (cadar (ssnamex js 0)))
)
(setq
	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space
	(if (eq (getvar "CVPORT") 1)
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
	)
	e1name (sel_onlyText "\nSélectionner le 1er texte: ")
	string1 (if (vlax-property-available-p e1name 'TextString) (vlax-get e1name 'TextString))
	e2name (sel_onlyText "\nSélectionner le 2ème texte: ")
	string2 (if (vlax-property-available-p e2name 'TextString) (vlax-get e2name 'TextString))
)
(cond
	((and string1 string2)
		(vlax-put e1name 'TextString string2)
		(vlax-put e2name 'TextString string1)
	)
)
(prin1)
)

[zin29]

Super merci bonuscad

marche super pour la permutation des textes pour les lignes de repere.si tu peux me faire la meme chose pour changer texte destination par le texte source sans changer le texte source(defun:tcp du lisp) ce serait le TOP. merci d' avange

[bonuscad]

Tu peux faire identique en supprimant simplement la ligne

(vlax-put e1name 'TextString string2)

du code.

 

Rapidement j'ai refais une version pour intégrer le choix + un mode multiple.

 

(vl-load-com)
(defun c:swap_texte ( / AcDoc Space loop key_mod e1name e2name string1 string2)
(defun sel_onlyText (msg / js)
	(princ msg)
	(while
		(not
			(setq js
				(ssget "_+.:E:S:N" 
					(list
						(cons 0 "*TEXT,MULTILEADER,ATTRIB,INSERT")
						(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
						(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
					)
				)
			)
		)
	)
	(vlax-ename->vla-object (cadar (ssnamex js 0)))
)
(setq
	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	Space
	(if (eq (getvar "CVPORT") 1)
		(vla-get-PaperSpace AcDoc)
		(vla-get-ModelSpace AcDoc)
	)
	loop nil
)
(initget "Permutation Copie Multiple")
(while (eq (setq key_mod (getkword (strcat "\nMode opératoire [Permutation/Copie/Multiple] " (if loop "**MULTIPLE**" "") ": "))) "Multiple")
	(if (eq key_mod "Multiple")
		(if loop (setq loop nil) (setq loop T))
	)
	(initget "Permutation Copie Multiple")
)
(if (not key_mod) (setq key_mod "Copie"))
(cond
	(loop
		(while (setq e1name (sel_onlyText (strcat "\nSélectionner le texte source pour la " key_mod " **MULTIPLE**: ")))
			(setq
				string1 (if (vlax-property-available-p e1name 'TextString) (vlax-get e1name 'TextString))
				e2name (sel_onlyText (strcat "\nSélectionner le texte cible pour la " key_mod " **MULTIPLE**: "))
				string2 (if (vlax-property-available-p e2name 'TextString) (vlax-get e2name 'TextString))
			)
			(cond
				((and string1 string2)
					(if (eq key_mod "Permutation") (vlax-put e1name 'TextString string2))
					(vlax-put e2name 'TextString string1)
				)
			)
		)
	)
	(T
		(setq
			e1name (sel_onlyText (strcat "\nSélectionner le texte source pour la " key_mod  ": "))
			string1 (if (vlax-property-available-p e1name 'TextString) (vlax-get e1name 'TextString))
			e2name (sel_onlyText (strcat "\nSélectionner le texte cible pour la " key_mod ": "))
			string2 (if (vlax-property-available-p e2name 'TextString) (vlax-get e2name 'TextString))
		)
		(cond
			((and string1 string2)
				(if (eq key_mod "Permutation") (vlax-put e1name 'TextString string2))
				(vlax-put e2name 'TextString string1)
			)
		)
	)
)
(prin1)
)

 

NB: La boucle sans fin en mode multiple ne peut s'interrompre que par "Esc".

Normalement on évite ce genre de boucle, mais j'ai fais au plus court.

 

[Edité le 20/11/2009 par bonuscad]

[zin29]

super bonuscad marche du feu de dieu et genial le mode multiple.

encore merci.