Remplacer TEXTES dans textes et BLOCS

[rebcao]

Bonjour à Toutes et à Tous,

 

J'ai fait une recherche mais j'ai pas trouvé !!! :casstet:

 

Je sais que ça existe déjà... Je cherche un LISP qui REMPLACE les TEXTES, TEXT MULT et les ATTRIBUTS dans les BLOCS, sur le principe de la commande RECHERCHER-REMPLACER.

 

Merci pour vos réponses

 

 

Christian

 

 

[Edité le 15/6/2011 par rebcao]

[(gile)]

Salut,

 

Il me semble bien que Patrick_35 a fait un rechercher/remplacer amélioré.

 

La commande RECHERCHER traite les textes et valeurs d'attributs (non constants) dans les blocs, que lui reproches-tu ?

 

Sinon, je te propose un petit truc plus simple que cette commande, qui ne s'occupe que des blocs.

 

(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
(or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

;; gc:string-subst-all
;; Substitue toutes les occurences d'une chaîne par une autre dans un texte.
;;
;; Arguments
;; new   : la chaîne à substituer à 'pat'
;; pat   : le modèle à remplacer
;; str   : la chaîne dans la quelle rechercher le modèle
;; pos   : la position de départ de la recherche (ou nil pour 0)
;; word  : si non nil, seuls les mots entiers correspondant au modèle sont remplacés
(defun gc:string-subst-all (new pat str pos word / end)
 (while (setq pos (vl-string-search pat str pos))
   (setq end (+ pos (strlen pat)))
   (if	(or (not word)
    (and
      (or (= 0 pos) (wcmatch (substr str pos 1) "."))
      (or (= (strlen str) end)
	  (wcmatch (substr str (1+ end) 1) ".")
      )
    )
)
     (setq str (vl-string-subst new pat str pos))
     (setq pos (1+ pos))
   )
 )
 str
)

;; gc:NestedFindReplace
;; Substitue toutes les occurences d'une chaîne par une autre dans les objets textuels
;; (attributs, textes, mtextes) contenus dans les définitions ou références de blocs.
;;
;; Arguments
;; obj   : référence ou définition de bloc (vla-object)
;; new   : la chaîne à substituer à 'pat'
;; pat   : le modèle à remplacer
;; word  : si non nil, seuls les mots entiers correspondant au modèle sont remplacés
(defun gc:NestedFindReplace (obj new pat word / oName patt str)
 (setq	oName (vla-get-ObjectName obj)
patt  (if word
	(strcat "*." pat ".*," pat ".*,*." pat "," pat)
	(strcat "*" pat "*")
      )
 )
 (cond
   ((= oName "AcDbBlockTableRecord")
    (vlax-for o obj
      (setq oName (vla-get-ObjectName o))
      (cond
 ((= oName "AcDbBlockReference")
  (gc:NestedFindReplace o new pat word)
 )
 ((or (= oName "AcDbText")
      (= oName "AcDbMText")
      (and (= oName "AcDbAttributeDefinition")
	   (= (vla-get-Constant o) :vlax-true)
      )
  )
  (if (wcmatch (setq str (vla-get-TextString o)) patt)
    (vla-put-TextString o (gc:string-subst-all new pat str 0 word))
  )
 )
      )
    )
   )
   ((= oName "AcDbBlockReference")
    (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach	att (vlax-invoke obj 'GetAttributes)
 (if (wcmatch (setq str (vla-get-TextString att)) patt)
   (vla-put-TextString att (gc:string-subst-all new pat str 0 word))
 )
      )
    )
    (gc:NestedFindReplace (vla-item *blocks* (vla-get-Name obj)) new pat word)
   )
 )
)

;; NFR
;; Commande
(defun c:NFR (/ *error* tmp file status new pat word ss all)
 (defun *error*	(msg)
   (or	(= msg "Fonction Annulée")
(princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (setq	tmp  (vl-filename-mktemp "Tmp.dcl")
file (open tmp "w")
 )
 (write-line
   "nfr:dialog{
     label = \"Rechercher et remplacer dans les blocs\";
     initial_focus = \"pat\";
     :text{ label = \"Rechercher :\"; }
     :edit_box{ key = \"pat\"; edit_width = 48; }
     spacer;
     :text{ label = \"Remplacer :\"; }
     :edit_box{ key = \"new\"; edit_width = 48; }
     spacer;
     :row{
       :toggle{ label = \"Mot entier\"; key = \"word\"; }
       spacer;
       spacer;
       :toggle{ label = \"Tout le dessin\"; key = \"all\"; }
       :button{ label = \">>\"; key = \"ss\"; }
     }
     ok_cancel;}"
   file
 )
 (close file)
 (setq	new    ""
pat    ""
all    T
dcl_id (load_dialog tmp)
 )
 (setq status 2)
 (while (>= status 2)
   (if	(not (new_dialog "nfr" dcl_id))
     (exit)
   )
   (set_tile "pat" pat)
   (set_tile "new" new)
   (set_tile "word"
      (if word
	"1"
	"0"
      )
   )
   (set_tile "all"
      (if ss
	"0"
	"1"
      )
   )
   (mode_tile "accept"
       (if (or ss all)
	 0
	 1
       )
   )
   (action_tile "pat" "(setq pat $value)")
   (action_tile "new" "(setq new $value)")
   (action_tile "word" "(setq word (if (= \"1\" $value) T nil))")
   (action_tile
     "all"
     "(if (= \"1\" $value)
       (progn
       (setq all T ss nil)
       (mode_tile \"accept\" 0))
       (progn
       (setq all nil)
       (mode_tile \"accept\" (if ss 0 1))))"
   )
   (action_tile "ss" "(done_dialog 3)")
   (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
   (setq status (start_dialog))
   (if	(= status 3)
     (setq all	nil
    ss	(ssget '((0 . "INSERT")))
     )
   )
 )
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (if (= status 1)
   (progn
     (vla-EndUndoMark *acdoc*)
     (if all
(setq ss (ssget "_X" '((0 . "INSERT"))))
     )
     (if ss
(progn
  (vlax-for obj	(setq ss (vla-get-ActiveSelectionSet *acdoc*))
    (gc:NestedFindReplace obj new pat word)
  )
  (vla-delete ss)
)
     )
     (vla-regen *acdoc*
	 (if all
	   acAllViewports
	   acActiveViewport
	 )
     )
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

[rebcao]

Bonjour,

 

Merci GIlles.

 

que lui reproches-tu ?

 

EUh ben rien ! j'ai pas fait de reproche ! :)

 

Christian

[bryce]

Bonjour,

 

La commande RECHERCHER traite les textes et valeurs d'attributs (non constants) dans les blocs, que lui reproches-tu ?

 

De ne pas pouvoir être utilisée en ligne de commande (dans un script par exemple) ?! :mad:

[(gile)]

Bonjour,

 

La commande RECHERCHER traite les textes et valeurs d'attributs (non constants) dans les blocs, que lui reproches-tu ?

 

De ne pas pouvoir être utilisée en ligne de commande (dans un script par exemple) ?! :mad:

 

En l'état, le LISP que j'ai donné non plus : entrées utilisateur plus boite de dialogue...