Transformation de Champ en Texte dans plusieurs présentation.

[Akkroma]

Bonjour , j'ai un souci avec des passages de plan dans un logiciel de contrôle.

Actuellement j'utilise le champ Ctab dans les variable système pour l'indication du numéro de plan. 

mais le logiciel de contrôle ne reconnait pas le format.

du coup je cherche un moyen de transformée tous les champs en texte.

j'ai sur ce dossier 55 plans avec tous un cartouche ayant le même Nom de bloc .

le problème du Gate étant de revenir 1 a 1 sur les cartouche.

j'ai testé un lisp mais converti tous les champs du ctab en texte du premier champ trouvée "01"

Champ-texte .lsp

 avez vous une solution pour ce petit souci ?

 

PS : je ne maitrise pas les lisp ='( 

[Fraid]

Bonjour,

Comme je suis l'auteur du Lisp, je vais essayer de t'aider.

Mais pour cela, j'aurais besoin d'un Bloc en exemple pour tester.

Merci

[Akkroma]

DSP3373058C213759L45PGC.dwg

Hello merci de ton aide . voici un fichier avec le bloc présentation 

 

 

voici le champ qui me pose problème , a savoir que si je trouve une solution je peu faire tous le nom de dossier en automatique =( . 

[Akkroma]

actuellement il indique 01 a la place du numéros de présentation. 

 

PS :  ton lisp correspond au meilleur par rapport a ma situation que j'ai réussi a trouvée  

[Fraid]

Bonjour,

Le problème est lié au fait que ton champs CTAB correspond à la présentation active.

Le Lisp ne change pas de présentation, et encore moins quand on traite un dossier.

Je n'avais pas envisagé ce champs. 

Je pense pouvoir modifier le code afin de récupérer le nom de la présentation autrement si CTAB utilisé.

Par contre cela sera dans la soirée.

[Akkroma]

Merci a toi , aucun souci

tu m'aide je ne vais pas faire mon difficile 😃 

 

[Fraid]

Yop,

En attendant que je trouve une solution plus rapide voici celle qui change de présentation au fur et à mesure.

C'est long mais fait le travail. 

Attention, pas en choisissant un dossier, mais seulement dans un dessin ouvert.

;;;field2txt Conversion des champs en textes
;;;Supprime les champs et les remplace par leurs valeurs
;;;acdc, (vla-get-activedocument (vlax-get-acad-object)) ou ObjectDBX
;;;tapper f2t pour traiter le dessin courant ou f2tindir pour traiter un dossier
;;;Converti les Textes, Mtextes, repères, repères multiples, cotations, Attributs et tableaux
;;;dans chaques présentations et les blocks
(defun field2txt ( acdc / delfield getconstantatt)
    (defun delfield (ob / objname objlay lays dic ind atts lconst ctc ctr lver)
        (setq objname (vla-get-objectname ob) 
              objlay (vla-get-layer ob) 
              lays (vla-get-layers acdc)
        )
        (and (= (vla-get-freeze (vla-item lays objlay)) :vlax-false)
             (= (vla-get-lock (vla-item lays objlay)) :vlax-false)
             ;(not (member objlay '("0" "EXCLU")));option d'exclusion de calques
            (progn
            (and (wcmatch objname "*Text,AcDbMLeader");Texte, Mtextes, repères et repères multiples
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD")) 
                 (setq ind (vla-get-textstring ob))
                 (progn
                    (vla-put-textstring ob " ")
                    (vla-put-textstring ob ind)
                 )
            )
            (and (wcmatch objname "*Dimension");Cotations
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD")) 
                 (setq ind (vla-get-textoverride ob))
                 (progn
                    (vla-put-textoverride ob " ")
                    (vla-put-textoverride ob ind)
                 )
            )
            (and (eq objname "AcDbBlockReference");Attributs
                 (setq atts (vlax-invoke ob 'GetAttributes) lconst (getconstantatt ob))
                 (foreach att atts
                    (and (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary att) "ACAD_FIELD"))
                         (not (member (vla-get-TagString att) lconst))
                         (setq ind (vla-get-textstring att))
                         (progn
                            (vla-put-textstring att " ")
                            (vla-put-textstring att ind)
                         )
                     )
                 )
            )
            (and (eq objname "AcDbTable");Tableaux
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD"))
                 (setq ctr 0 ctc 0 )
                 (while (< ctr (vla-get-rows ob)) 
                    (while (< ctc (vla-get-columns ob))
                        (and (/= (vla-GetCellState ob ctr ctc) 1)
                             (/= (vla-GetCellState ob ctr ctc) 17)
                             (setq ind (vlax-invoke ob 'getcellvalue ctr ctc))
                             (progn
                                (vlax-invoke ob 'setcellvalue ctr ctc " ")
                                (vlax-invoke ob 'setcellvalue ctr ctc ind)
                             )
                        )
                        (setq ctc (1+ ctc))
                    )
                    (setq ctc 0 ctr (1+ ctr))
                 )
            )
          )
        )
    );fin delfield
    
    ;;;getconstantatt
    ;;;bl, vla objet (block) 
    ;;;Retourne la liste des étiquettes des attributs constants
    (defun getconstantatt ( bl / lc)
        (setq lc '())
        (vlax-for bls  (vla-get-blocks acdc)
            (if (eq (vlax-get bls 'Name)(vlax-get bl 'Name))
                (vlax-for obj bls
                    (and (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
                         (= (vla-get-Constant obj) :vlax-true)
                         (setq lc (cons (vla-get-TagString obj) lc))
                    )
                )
            )
        )
        lc 
    ) 
    
    ;Définitions de blocks
    (vlax-for bl  (vla-get-blocks acdc)
        (and (= (vla-get-islayout bl) :vlax-false)
             (= (vla-get-IsXRef bl) :vlax-false)
             (= (vla-get-IsDynamicBlock bl) :vlax-false)
             (not (wcmatch (vla-get-name bl) "`*T*"))
             (vlax-for obj  bl 
                    (delfield obj)
             )
        )
    )
    ;Chaque présentations
    (vlax-for layout  (vlax-get-property acdc 'layouts)
        (vla-put-ActiveLayout acdc layout)
        (vlax-for obj  (vlax-get-property layout 'block)
                (delfield obj)
        )
    )
    (princ)
);fin field2txt
;Commande pour dessin courant
(defun c:f2t (/ ac) (field2txt (setq ac (vla-get-activedocument (vlax-get-acad-object)))) (vla-Regen ac acAllViewports)(princ))

Tu charge et tape f2t, et tu attend ...

[Akkroma]

merci en attendant ca a marché 😃

 

[Fraid]

Bonjour,

J'ai trouvé une solution plus rapide et qui fonctionne avec odbx permettant de traiter tout un dossier,

mais qui fonctionneras uniquement avec des dessins contenant ce cartouche.

Je n'ai pas réussi à écrire un code générique traitant la variable CTAB particulièrement.

La formule des champs est difficile à attraper dans les attributs. Je continu à chercher quand même, cela m'intéresse.

;;;field2txt Conversion des champs en textes
;;;Supprime les champs et les remplace par leurs valeurs
;;;acdc, (vla-get-activedocument (vlax-get-acad-object)) ou ObjectDBX
;;;taper f2t pour traiter le dessin courant ou f2tindir pour traiter un dossier
;;;Converti les Textes, Mtextes, repères, repères multiples, cotations, Attributs et tableaux
;;;dans chaques présentations et les blocks
(defun field2txt ( acdc / delfield getconstantatt)
    (defun delfield (ob layoutname / objname objlay lays dic ind atts lconst ctc ctr lver tag)
        (setq objname (vla-get-objectname ob) 
              objlay (vla-get-layer ob) 
              lays (vla-get-layers acdc)
        )
        (and (= (vla-get-freeze (vla-item lays objlay)) :vlax-false)
             (= (vla-get-lock (vla-item lays objlay)) :vlax-false)
             ;(not (member objlay '("0" "EXCLU")));option d'exclusion de calques
            (progn
            (and (wcmatch objname "*Text,AcDbMLeader");Texte, Mtextes, repères et repères multiples
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD")) 
                 (setq ind (vla-get-textstring ob))
                 (progn
                    (vla-put-textstring ob " ")
                    (vla-put-textstring ob ind)
                 )
            )
            (and (wcmatch objname "*Dimension");Cotations
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD")) 
                 (setq ind (vla-get-textoverride ob))
                 (progn
                    (vla-put-textoverride ob " ")
                    (vla-put-textoverride ob ind)
                 )
            )
            (and (eq objname "AcDbBlockReference");Attributs
                 (setq atts (vlax-invoke ob 'GetAttributes) lconst (getconstantatt ob))
                 (foreach att atts
                    (setq tag (vla-get-TagString att))
                    (and (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary att) "ACAD_FIELD"))
                         (not (member tag lconst))
                         (setq ind (vla-get-textstring att))
                         (progn
                            (if (eq tag "NO") (setq ind layoutname))
                            (if (eq tag "REF_DSP")(setq ind (strcat (substr ind 1 (1+ (vl-string-position (ascii "_") ind nil T))) layoutname)))
                            (vla-put-textstring att " ")
                            (vla-put-textstring att ind)
                         )
                     )
                 )
            )
            (and (eq objname "AcDbTable");Tableaux
                 (vl-catch-all-apply 'vla-item (list (vla-getextensiondictionary ob) "ACAD_FIELD"))
                 (setq ctr 0 ctc 0 )
                 (while (< ctr (vla-get-rows ob)) 
                    (while (< ctc (vla-get-columns ob))
                        (and (/= (vla-GetCellState ob ctr ctc) 1)
                             (/= (vla-GetCellState ob ctr ctc) 17)
                             (setq ind (vlax-invoke ob 'getcellvalue ctr ctc))
                             (progn
                                (vlax-invoke ob 'setcellvalue ctr ctc " ")
                                (vlax-invoke ob 'setcellvalue ctr ctc ind)
                             )
                        )
                        (setq ctc (1+ ctc))
                    )
                    (setq ctc 0 ctr (1+ ctr))
                 )
            )
          )
        )
    );fin delfield
    
    ;;;getconstantatt
    ;;;bl, vla objet (block) 
    ;;;Retourne la liste des étiquettes des attributs constants
    (defun getconstantatt ( bl / lc)
        (setq lc '())
        (vlax-for bls  (vla-get-blocks acdc)
            (if (eq (vlax-get bls 'Name)(vlax-get bl 'Name))
                (vlax-for obj bls
                    (and (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
                         (= (vla-get-Constant obj) :vlax-true)
                         (setq lc (cons (vla-get-TagString obj) lc))
                    )
                )
            )
        )
        lc 
    ) 
    
    ;Définitions de blocks
    (vlax-for bl  (vla-get-blocks acdc)
        (and (= (vla-get-islayout bl) :vlax-false)
             (= (vla-get-IsXRef bl) :vlax-false)
             (= (vla-get-IsDynamicBlock bl) :vlax-false)
             (not (wcmatch (vla-get-name bl) "`*T*"))
             (vlax-for obj  bl 
                    (delfield obj "")
             )
        )
    )
    ;Chaque présentations
    (vlax-for layout  (vlax-get-property acdc 'layouts)
        (vlax-for obj  (vlax-get-property layout 'block)
                (delfield obj (vla-get-name layout))
        )
    )
    (princ)
);fin field2txt
;Commande pour dessin courant
(defun c:f2t (/ ac) (setvar 'ctab "Model") (field2txt (setq ac (vla-get-activedocument (vlax-get-acad-object)))) (vla-Regen ac acAllViewports)(princ))
;Commande pour dossier (non récursif)
(defun c:f2tindir ( / dir lf axdbdoc) 
    (and (setq dir (getdir))
         (setq lf (vl-directory-files dir "*.dwg" 1))
         (foreach f lf
            (if (setq axdbdoc (getaxdbdoc (strcat dir f)))
                (field2txt axdbdoc)
            )
            (vla-saveas axdbdoc (strcat dir f))
            (vlax-release-object axdbdoc)
         )
    )
    (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getdir( / shell rep)
     (setq shell (vlax-create-object "Shell.Application")
            rep (vlax-invoke shell 'browseforfolder 0 "Sélectionnez le dossier" 512 "")
     )
     (vlax-release-object shell)
     (strcat (vlax-get-property (vlax-get-property rep 'self) 'path) "\\")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getaxdbdoc (filename / axdbdoc release)
     (setq axdbdoc
        (vlax-create-object
          (if (< (setq release (atoi (getvar "ACADVER"))) 16)
            "ObjectDBX.AxDbDocument"
            (strcat "ObjectDBX.AxDbDocument." (itoa release))
          )
        )
     )
     (if (vl-catch-all-apply 'vla-open (list axdbdoc filename))
       (not (vlax-release-object axdbdoc))
       axdbdoc
     )
)

Taper f2t, pour le dessin courant, ou f2tindir pour traiter un dossier.

[Akkroma]

Merci pour ton temps 😃