Ajouter un prefixe dans un texte

[farfar974123]

Bonjour à tous.

 

Je me suis lancé dans un petit programme afin de me simplifier la vie. Le but de celui-ci est donc de rajouter un préfixe à un texte.

 

Voila mon bout de code (non terminé):

(defun c:pp()

 

(setq a(car(entsel"\ choisir le texte à modifier")))

 

(setq b(entget a))

 

(setq txt(atoi(cdr(assoc 1 b))))

 

(entmod (sub

 

)

 

 

Comme vous pouvez le voir c'est la ligne (entmod (sub.....) qui me pose probléme, car en fait mon but est de récuperer un texte, qui est un chiffre style "1043" et d'arriver à afficher "AV-1043"

.La je bloques car je n'arrive pas à associer AV et 1043.

 

Bon je suis pas trés clair, mais à l'aide...

 

 

 

 

[farfar974123]

En cherchant dans le forum j'ai trouvé mon bonheur. Le code n'est pas de moi, mais il fait exactement ce que je cherchais à faire (Sa tombe bien)

 

(defun c:pr (/ I SEL TXT TXT-R)

 

(setq sel (ssget '((0 . "*TEXT"))))

 

(repeat (setq i (sslength sel))

 

(setq txt (cdr (assoc 1 (entget (ssname sel (setq i (1- i))))))

 

txt-r (strcat "AV - " txt))

 

(entmod (subst (cons 1 txt-r) (cons 1 txt) (entget (ssname sel i))))

 

)

 

(princ (strcat "\n" (rtos (sslength sel)) " Texte(s) modifié(s)."))

 

(princ)

 

)

 

Bon maintenant je vais essayer de décortiquer et de comprendre tout cela.

 

A+ les Cadxp!!

[lecrabe]

Hello

 

Voici un bon vieux Lisp que j'utilise depuis longtemps !

 

Attention, il ne traite que les textes simples et non pas les Multi-Textes !!

 

2 commandes sont dispo :

ADP pour ajouter un prefixe

ADS pour ajouter un suffixe

 

Le Decapode

 

 

;;
;; Copyright 2001 EMT Software, Inc. - MTEXT not allowed
;; Micro-Modif par Patrice
;;

(defun C:ADP (/ #SSET #CNT #IDX #ENT #TXT)

;;   (setq #TXT  (getstring    "\nText for Prefix : ")
    (setq #TXT  (getstring T "\nText for Prefix : ")

       #SSET (ssget (list (cons 0 "TEXT")))
       #CNT  0)
 (if (not #SSET) (setq #IDX 0) (setq #IDX (sslength #SSET)))
 (while (/= #CNT #IDX)
   (setq #ENT (entget (ssname #SSET #CNT))
         #ENT (subst (cons 1 (strcat #TXT (cdr (assoc 1 #ENT)))) (assoc 1 #ENT) #ENT))
   (entmod #ENT)
   (setq #CNT (1+ #CNT)))

 (princ))

;; Uncomment for the language needed.
;; (princ "\n\nADP‚ð“ü—Í‚µ‚ÄŠJŽn")  ; For Japanese.
  (princ "\nADD Prefix on TEXT Entity - Type ADP to start.") ; For English.

(princ)

;;
;; Copyright 2001 EMT Software, Inc. - MTEXT not allowed
;; Micro-Modif par Patrice
;;

(defun C:ADS (/ #SSET #CNT #IDX #ENT #TXT)

;;  (setq #TXT  (getstring    "\nText for Suffix : ")
   (setq #TXT  (getstring T "\nText for Suffix : ")

       #SSET (ssget (list (cons 0 "TEXT")))
       #CNT  0)
 (if (not #SSET) (setq #IDX 0) (setq #IDX (sslength #SSET)))
 (while (/= #CNT #IDX)
   (setq #ENT (entget (ssname #SSET #CNT))
         #ENT (subst (cons 1 (strcat (cdr (assoc 1 #ENT)) #TXT)) (assoc 1 #ENT) #ENT))
   (entmod #ENT)
   (setq #CNT (1+ #CNT)))

 (princ))

;; Uncomment for the language needed.
;; (princ "\n\nADS‚ð“ü—Í‚µ‚ÄŠJŽn")  ; For Japanese.
  (princ "\nADD Suffix on TEXT Entity - Type ADS to start.") ; For English.

(princ)

 

 

[fabcad]

Bonjour,

 

si cela peut de servir de base :

 

; création le 03/04/1996
; BUT : MODIFIE LES CARACTÉRISTIQUES D'UN OU PLUSIEURS TEXTES
; **********************************************************************************
(defun mod-so (js / nom_ent i chn nbr ent)            		
       (setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (strcat "%%U" chn))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
)
; **********************************************************************************
(defun mod-su (js / nom_ent i chn nbr ent)            		
       (setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (strcat "%%o" chn))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
)
; **********************************************************************************
(defun mod-diam (js / nom_ent i chn nbr ent)            		
       (setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (strcat "%%C " chn))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
)
; **********************************************************************************
(defun mod-pourc (js / nom_ent i chn nbr ent)            		
       (setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (strcat "%%%" chn))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
)
; **********************************************************************************
(defun mod-degre (js / nom_ent i chn nbr ent suf)            		
       (setq suf (getstring T "\n suffixe : "))
(setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (strcat suf "%%D" chn))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
)
; **********************************************************************************
(defun mod-rien (js / nom_ent i chn nbr ent)            		
       (setq nbr (sslength js))
       (setq i 0)
       (while (<= i (- nbr 1))
               (setq nom_ent (ssname js i))
	(setq ent (entget nom_ent))
	(setq chn (cdr (assoc 1 ent)))
	(setq chn (substr chn 4))
	(setq ent (subst (cons 1 chn) (assoc 1 ent) ent))
	(entmod ent)
(setq i (+ i 1))
       ); fin while
       (setvar "cmdecho" 1)
); **********************************************************************************
; FONCTION MAITRE
(defun C:suffixe ( / chx chn ent)
(setvar "cmdecho" 0)
(setq filtre (list (cons 0 "TEXT")))
(setq js (ssget filtre))
(initget "Souligne Surligne Diametre Pourcent dEgre Normal")
(setq chx (getkword "\n Suffixes : /Surligne/Diametre/Pourcent/dEgre/Normal : "))
(if (= chx nil) (setq chx "Souligne"))
 	(cond
	((= chx "Souligne") (mod-so js))
	((= chx "Surligne") (mod-su js))
	((= chx "Diametre") (mod-diam js))
	((= chx "Pourcent") (mod-pourc js))
	((= chx "dEgre") (mod-degre js))
	((= chx "Normal") (mod-rien js))
);fin 1 cond
);fin c:mod-txt

; **********************************************************************************
; fonction de conversion de degrés vers radian

(defun dtr (a)
(* pi (/ a 180.0))
); fin defun dtr
; **********************************************************************************

[farfar974123]

Salut les gars!

 

Merci de vos réponses, et de votre rapidité. Fabcad tu as crée ce lisp en 1996!! J'ai beaucoup de retard à rattraper.

 

Je vais essayer de décortiquer ses deux codes., et comprendre les fonctions while et if, qui sont incontournable pour avancer en lisp.

 

Merci et A+