Bloc+texte ---> Bloc+attribut

[bono05]

Bonjour à tous,

 

Voici mon problème:

 

J'ai un plan avec 1 bloc qui est repris plus de 200 fois et qui ont chacun un texte.

J'aimerai savoir si il était possible de créer un lisp où je puisse selectionner un des blocs puis son texte afin qu'il le convertisse en bloc/attribut.

L'idée est qu'il garde le contenu du texte selectionné ainsi que sa position et sa rotation.

 

Si je dois répéter plus de 200 fois la commande ce n'est pas grave!

 

D'avance merci de m'aider.

 

Bono.

[alala]

Ça ne me parrait pas impossible, mais si tu veu automatiser un maximum le plus simple serais de savoir définir la sélection du texte en fonction d'une variable commune à tous ceux-ci en fonction du bloc.

 

Par exemple si tous tes texte sont à une distance ou une position précise (ou maxi) par rapport au bloc à attacher.

 

Au pire il faudra sélectionner chaque bloc et chaque texte associé.

 

Maintenant ton bloc dispose il d'un attribut? Faudrait il le créer? A tu le bloc qui le remplacerait?

 

Un sujet en rapport : http://cadxp.com/index.php?/topic/30010-convertir-texte-en-attribut/

Un autre : http://cadxp.com/index.php?/topic/25036-est-il-possible-de-transformer-un-texte-en-bloc-avec-attribut/

 

Et il y en pas mal sur le net dans ce genre.

[bono05]

Salut alala,

 

J'ai donc plus de 200 fois un bloc sans attribut...et avec un texte lui donnant un numéro.

 

Si je dois selectionner chaque bloc et chaque texte associée....c'est pas grave.

 

Si nécessaire je peux bien entendu créer un attribut dans mon bloc en question.

 

Mais le plus important pour moi c'est que le texte selectionner (et se transformant donc en attribut) garde sa position et son angle de rotation sur mon plan.

 

Ps: j'ai testé les liens, mais cela ne correspond pas vraiment à ce que je recherche.

 

D'avance GRAND merci!

[bryce]

Bonjour,

 

Pourrais-tu poster un morceau de dessin en exemple ?

[bono05]

Bonjour,

 

Pourrais-tu poster un morceau de dessin en exemple ?

 

Comment puis-je mettre le plan en dwg sur mon post?

 

je reçois ce message en retour:

"Erreur Vous n'avez pas la permission d'envoyer ce type de fichier."

[bryce]

Il faut le zipper. ;)

[bono05]

Il faut le zipper. ;)

 

 

Voici le fichier zipper.

 

Les carrés mauves sont des boites de sol et c'est ce bloc (auquel j'ai déjà créer un attribut) qui doit avoir les textes converti en attribut.

FLOOR +06.zip

[bryce]

Bonjour,

 

Voici un Lisp qui devrait t'aider:

 

(defun c:TEXT2ATT ( / plist textcolor textlayer *error* acdoc ucss filter ucsicon ucsfollow ss del tag scu blocs
                     textes tmp ptl p1 p2 bp closest d1 d2 d dist effl atts att )
; Dans une sélection de blocs et textes, récupère le texte le plus proche du bloc et l'injecte dans le 1er attribut.
; Brice Studer, 11/2012

 (setq
   ; Liste des propriétés de texte à appliquer à l'attribut
   plist '("Alignment" "InsertionPoint" "TextAlignmentPoint" "Rotation" "TrueColor")
   ; Index de la couleur à appliquer aux textes traités (commenter la ligne ci-dessous pour désactiver le changement de couleur)
   textcolor 3
   ; Nom du calque (existant ou pas) sur lequel déplacer les textes traités (commenter la ligne ci-dessous pour désactiver le changement de calque)
   ;textlayer "text2att_done"
 )
 
 (vl-load-com)
 (defun *error* (msg)
   (and msg
     (or
       (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
       (princ (strcat "\nErreur : " msg))
     )
   )
   (if ss (vla-delete ss))
   (vla-put-activeucs acdoc scu)
   (setvar 'cmdecho 1)
   (setvar 'ucsicon ucsicon)
   (setvar 'ucsfollow ucsfollow)
   (vla-endundomark acdoc)
   (princ)
 )
 
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       ucss (vla-get-usercoordinatesystems acdoc)
       filter '( (0 . "INSERT,TEXT") ))
 (vla-startundomark acdoc)
 
   (if (cadr (ssgetfirst))
   (setq ss (ssget "_I" filter))
   (progn
     (prompt "\nSélectionnez les textes et blocs à associer ou <entrée pour tout> : ")
     (or
       (setq ss (ssget filter))
       (setq ss (ssget "_A" filter))
     )
   )
 )
 (if ss
   (progn
     (initget "Oui Non")
     (setq del (getkword "\nEffacer les textes ? [Oui/Non] <Non>: ")
           del (= del "Oui")
           tag (strcase (getstring "\nEtiquette de l'attribut à renseigner <entrée pour le 1er>: "))
           ss (vla-get-activeselectionset acdoc))
     (setvar 'cmdecho 0)
     (setq ucsicon (getvar 'ucsicon)
            ucsfollow (getvar 'ucsfollow))
     (setvar 'ucsicon 0)
     (setvar 'ucsfollow 0)
     (if (= "" (getvar 'ucsname))
       (setq scu (vla-add ucss (vlax-3D-point (trans '(0 0 0) 1 0)) (vlax-3D-point (trans '(1 0 0) 1 0)) (vlax-3D-point (trans '(0 1 0) 1 0)) "$text2attucs"))
       (setq scu (vla-get-activeucs acdoc))
     )
     (vlax-for e ss
       (cond
         ((= (vla-get-objectname e) "AcDbBlockReference")
           (vla-getboundingbox e 'p1 'p2)
           (setq p1 (vlax-safearray->list p1)
                 p2 (vlax-safearray->list p2)
                 bp (mapcar '(lambda( a b ) (/ (+ a B) 2.0)) p1 p2)
                 blocs (cons (list e bp) blocs))
         )
         ((= (vla-get-objectname e) "AcDbText")
           (command "_ucs" "_e" (vlax-vla-object->ename e))
           (setq ptl (textbox (entget (vlax-vla-object->ename e)))
                 p1 (car ptl)
                 p2 (cadr ptl)
                 p1 (list (car p1) (/ (+ (cadr p1) (cadr p2)) 2) 0)
                 p2 (list (car p2) (/ (+ (cadr p1) (cadr p2)) 2) 0)
                 p1 (trans p1 1 0)
                 p2 (trans p2 1 0)
                 textes (cons (list e p1 p2) textes))
         )
       );cond
     ); vlax-for
     (foreach b blocs
       (setq closest nil
             dist nil
             bp (cadr B))
       (if tmp (setq textes tmp tmp nil))
       (foreach te textes
         (setq d1 (distance bp (cadr te))
               d2 (distance bp (caddr te))
               d (min d1 d2))
         (if (not dist)
           (setq dist d
                 closest te)
           (if (/= dist (setq dist (min dist d)))
             (setq tmp (cons closest tmp)
                   closest te)
             (setq tmp (cons te tmp))
           )
         )
       );foreach texte
       (if (and
             (setq closest (car closest))
             (setq atts (vlax-invoke (car B) 'getattributes))
             (if (= tag "")
               (setq att (car atts))
               (progn
                 (foreach a atts
                   (if (= (vla-get-tagstring a) tag)
                     (setq att a)
                   )
                 )
                 att
               )
             )
           )
         (progn
           (vla-put-textstring att (cdr (assoc 1 (entget (vlax-vla-object->ename closest)))))
           (foreach p plist
             (vl-catch-all-apply 'eval (list (read (strcat "(vla-put-" p " att (vla-get-" p " closest))"))))
           )
           (if del
             (setq effl (cons closest effl))
             (progn
               (if textcolor (vla-put-color closest textcolor))
               (if textlayer
                 (entmod (subst (cons 8 textlayer) (assoc 8 (setq closest (entget (vlax-vla-object->ename closest)))) closest))
               )
             )
           ); if del
         );progn
       );if
     );foreach bloc
     (if del
       (mapcar '(lambda (x) (vl-catch-all-apply 'vla-erase (list x))) effl)
     )
   );progn if ss
 )
 (*error* nil)
)

 

Le programme récupère le texte le plus proche du bloc et l'injecte dans le 1er attribut.

 

Quelques conseils d'utilisation :

- gèle tous les calques sauf "CAO19-DIVERS" et "data txt"

- je te conseille d'appliquer la commande en sélectionnant chaque fois quelques dizaines de blocs avec leurs textes, et en effaçant les textes au fur et à mesure.

 

Si tu appliques la commande à tout le dessin en une fois:

- ça va mouliner plusieurs minutes (la vitesse de traitement pourrait être largement optimisée, mais je n'ai pas le temps pour le moment)... => problème réglé

- il y aura quelques erreurs, car parfois le texte le plus proche du bloc n'est pas le bon. Il vaut mieux dans ce cas ne pas effacer les textes, et vérifier attentivement le résultat.

Modifié le 18 novembre 2012 par bryce

[bono05]

Bonjour,

 

Voici un Lisp qui devrait t'aider:

 

(defun c:TEXT2ATT ( / plist acdoc filter *error* icon ss del blocs textes ptl p1 p2 bp closest d1 d2 d dist effl )

 (setq plist '("Alignment" "InsertionPoint" "TextAlignmentPoint" "Rotation" "TrueColor") ) ; Liste des propriétés de texte à appliquer à l'attribut
 
 (vl-load-com)
 
 (defun *error* (msg)
   (and msg
     (or
       (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
       (princ (strcat "\nErreur : " msg))
     )
   )
   (if ss (vla-delete ss))
   (setvar 'cmdecho 1)
   (setvar 'ucsicon icon)
   (vla-endundomark acdoc)
   (princ)
 )
 
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       filter '( (0 . "INSERT,TEXT") ))
 (vla-startundomark acdoc)
 
   (if (cadr (ssgetfirst))
   (setq ss (ssget "_I" filter))
   (progn
     (prompt "\nSélectionnez les textes et blocs à associer ou <entrée pour tout> : ")
     (or
       (setq ss (ssget filter))
       (setq ss (ssget "_A" filter))
     )
   )
 )
 (if ss
   (progn
     (initget "Oui Non")
     (setq del (getkword "\nEffacer les textes ? [Oui/Non] <Non>: ")
           del (= del "Oui"))
     (setq ss (vla-get-activeselectionset acdoc))
     (vlax-for e ss
       (cond
         ((= (vla-get-objectname e) "AcDbBlockReference")
           (setq blocs (cons e blocs))
         )
         ((= (vla-get-objectname e) "AcDbText")
           (setq textes (cons e textes))
         )
       );cond
     )
     (setvar 'cmdecho 0)
     (setq icon (getvar 'ucsicon))
     (setvar 'ucsicon 0)
     (foreach b blocs
       (vla-getboundingbox b 'p1 'p2)
       (setq p1 (vlax-safearray->list p1)
             p2 (vlax-safearray->list p2))
       (setq bp (mapcar '(lambda( a b ) (/ (+ a B) 2.0)) p1 p2)
             closest nil
             dist nil)
       (foreach te textes
         (setq ptl (textbox (entget (vlax-vla-object->ename te))))
         (command "_ucs" "_e" (vlax-vla-object->ename te))
         (setq d1 (distance bp (trans (car ptl) 1 0))
               d2 (distance bp (trans (cadr ptl) 1 0))
               d (min d1 d2))
         (command "_ucs" "_p")
         (if (not dist)
           (setq dist d
                 closest te)
           (if (/= dist (setq dist (min dist d)))
             (setq closest te)
           )
         )
       );foreach texte
       (if (and closest (setq att (car (vlax-invoke b 'getattributes))))
         (progn
           (vla-put-textstring att (cdr (assoc 1 (entget (vlax-vla-object->ename closest)))))
           (foreach p plist
             (vl-catch-all-apply 'eval (list (read (strcat "(vla-put-" p " att (vla-get-" p " closest))"))))
           )
           (if del (setq effl (cons closest effl)))
         )        
       )
     );foreach bloc
     (if del (vl-catch-all-apply 'vla-erase effl))
   );progn
 )
 (*error* nil)
)

 

Le programme récupère le texte le plus proche du bloc et l'injecte dans le 1er attribut.

 

Quelques conseils d'utilisation :

- gèle tous les calques sauf "CAO19-DIVERS" et "data txt"

- je te conseille d'appliquer la commande en sélectionnant chaque fois quelques dizaines de blocs avec leurs textes, et en effaçant les textes au fur et à mesure.

 

Si tu appliques la commande à tout le dessin en une fois:

- ça va mouliner plusieurs minutes (la vitesse de traitement pourrait être largement optimisée, mais je n'ai pas le temps pour le moment)...

- il y aura quelques erreurs, car parfois le texte le plus proche du bloc n'est pas le bon. Il vaut mieux dans ce cas ne pas effacer les textes, et vérifier attentivement le résultat.

 

C'est juste ENORME ton LISP!!!! Quel super résultats!

 

Comme tu le précise cela mouline si je veux faire le tout en une fois.

Normalement je ne devrai recevoir les plans officiels que d'ici une grosse semaine...Donc si tu peux essayer d'arranger cela...quand tu auras du temps je suis preneur. ;)

 

Sinon c'est déjà super, un tout GRAND merci pour ton aide!

Bono.

[bryce]

Je verrai, mais franchement je pense qu'il est de toutes façons préférable de procéder par "paquets" de quelques dizaines - une centaine de blocs, pour limiter les risques de passer à côté d'une erreur.

[bryce]

J'ai amélioré un peu le code, je suis passé à 40s de traitement sur le fichier exemple, au lieu de 2mn auparavant. ;)

[bono05]

Prèviens moi quand tu auras la version finale, je me ferai un plaisir à la tester! :P

 

Juste un petit plus? Pourrais-tu faire en sorte que les textes restants sur le plans (pour faire la vérification) change de couleurs (vert par exemple)?

Ainsi je vois plus aisement les blocs que j'ai déjà vérifier et les blocs que je dois encore vérifier...

[bryce]

Bonjour,

 

Quelques modifs:

- ajout de la possibilité de changer la couleur et/ou le calque des textes traités

- correction d'une erreur dans le code (les textes n'étaient pas effacés quand on le demandait).

 

Je pense que ce sera la version finale, à mois d'un gros bug. ;)

[bryce]

Bonjour,

 

J'étais passé à côté des optimisations les plus évidentes, le temps de traitement est passé à 1s sur le dessin test. :o

[bono05]

Bonjour Bryce,

 

Je confirme les modifications avec un test!

Et même mieux...alors qu'il y avait quelques erreurs de blocs qui ne prenaient pas toujours le bon texte (notamment dans la pointe en haut du plan...maintenant c'est un 100% de réussite!!

 

Je le (re)dit BRAVO!!!!!!!!!!!!!!!!! et merci! ;)

[bono05]

j'ai une erreur qui me fait perdre énormement de temps.

J'en appele à l'aide!!!

 

 

Avec text2att.lsp certains attributs n'apparaissent pas à leurs places initiales...pire certains ont complétement miroiter?! (les textes rouges étant le résulats final après lisp)

 

Attention!!! il ne s'agit plus du bloc représentant un carré...mais le point rouge que j'utilise pour ce faire.

 

Une idée du problème? lorsque je vérifie les propriètées de ces mauvais blocs je ne vois rien de différent et qui justifie ce résultats.

[bryce]

Bonjour,

 

Il faudrait que tu postes un fichier en exemple. ;)

Je ne pourrai pas faire de tests avant ce soir, je suis sur une LT aujourd'hui.

[bono05]

Le voici...

 

Ceci est un résultat après utilisation du lisp.

 

Autant avec les boites carrées je n'avais pas de soucis majeur...autant avec les p'tites boule rouges... :(

+06.zip

[bryce]

Pourrais-tu poster un exemple de fichier avant utilisation du lisp ?

[bono05]

erreur voir message suivant(je sais pas effacer ce fake) :blink:

[bono05]

Voici l'exemple demandé...

DATA +06.zip

[bryce]

Je viens de regarder les fichiers et j'ai trouvé le souci : certains des attributs ont une normale inversée.

Il suffit donc de modifier les paramètres du lisp, pour appliquer aux attributs la normale du texte correspondant.

Pour cela, ouvre le fichier .lsp dans un éditeur de texte (le Bloc-Notes, pas Word ;) ), et modifie la ligne

; Liste des propriétés de texte à appliquer à l'attribut
   plist '("Alignment" "InsertionPoint" "TextAlignmentPoint" "Rotation" "TrueColor")

comme ceci

; Liste des propriétés de texte à appliquer à l'attribut
   plist '("Normal" "Alignment" "InsertionPoint" "TextAlignmentPoint" "Rotation" "TrueColor")

 

J'ai testé sur tout le fichier en une fois, et ça a fonctionné.

Attention :

- tu as quelques textes multilignes sur la gauche, il faut les décomposer en textes

- il vaut mieux geler les autres calques, car en les désactivant simplement ils ne sont pas protégés !

[bono05]

Trop fort Bryce!!!

 

T'imagines même pas le temps que tu me fait gagner...car j'ai 12 ètages à faire. :D

 

Encore un tout GRAND merci!!

[bryce]

Ca fera 10€ par étage, j'accepte chèques, virements, Paypal. :P :P :P

[Teamscad]

Bonjour,

Peux tu svp m'envoyer le lisp ? par avance merci