Conversion des champs en textes

[Fraid]

Bonjour,

Un sujet mainte fois abordé, mais ici je me confronte à une trop grande efficacité du lisp.

Mon programme fonctionne trop bien, car je voudrais que les champs dans un attribut déclaré constant garde son champs, ainsi que les cellules avec le contenu verrouillé.

Mais malgré mais essais, ils sont convertis.

Voici le code (mis à jour après résolution des problèmes)

;;;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)
        (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))
;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
     )
)

Merci d'avance pour votre aide

[Luna]

Coucou,

J'ai l'impression que la propriété "Constant" n'est pas récupérable depuis les objets ATTRIB (issus d'une référence de bloc) car la valeur est toujours 0 (= :vlax-false). En revanche, la valeur est différente en passant par les objets ATTDEF (issus d'une définition de bloc) ! Donc pour palier à ton problème, tu vas devoir récupérer la définition de bloc via (tblobjname), créer une boucle pour récupérer la liste des attributs via (entnext), correspondant du coup aux objets ATTDEF et non ATTRIB. Et seulement avec ces objets, tu pourras vérifier l'équation

(= (vla-get-Constant att) :vlax-false)

J'avoue être assez perplexe devant cette subtilité et je n'ai pas vraiment vérifié si cela est propre à la propriété "Constant" des attributs ou bien si l'ensemble des propriétés "Divers" sont comme cela...

Bisous,
Luna

[Fraid]

Merci

Mais comme ce lisp est prévu pour traiter des dessins par lot (ObjectDBX), je suis obligé d'utiliser que du vla pour explorer les objets.

Cela fait plusieurs jours que je bute sur ce problème.

et c'est encore pire au sein des tableaux....

je n'ai pas réussi a tester la présence d'un champ par cellule mais seulement par tableau, du coup je modifie toutes les cellules ...

 

 

 

[Luna]

Et bien alors il suffit d'utiliser la méthode Visual pour récupérer la liste des objets :

(defun GetBlock (search filter / doc col blk lst tmp)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vlax-for col (vlax-get doc 'Blocks)
    (if (wcmatch (strcase (vlax-get col 'Name)) (strcase search))
      (progn
        (setq tmp nil)
        (vlax-for blk col
          (if (wcmatch (strcase (vlax-get blk 'ObjectName)) (strcase filter))
            (setq tmp (cons blk tmp))
          )
        )
        (setq lst (cons (cons (vlax-get col 'Name) tmp) lst))
      )
    )
  )
  lst
)

Avec 'search' une chaîne de caractère correspondant au nom du bloc recherchée (recherche relative via (wcmatch)) et 'filter' une chaîne de caractères correspondant au nom des sous-entités que l'on désire lister. Ci-dessous un exemple d'utilisation :

(GetBlock "BlockNameTest" "AcDbAttributeDefinition")
; returns :
(("BlockNameTest" #<VLA-OBJECT IAcadAttribute 000001dec91219d8> #<VLA-OBJECT IAcadAttribute 000001dec9124058> #<VLA-OBJECT IAcadAttribute 000001dec9121b98>))

et si après tu peux faire ce que tu veux :

(mapcar '(lambda (a) (cons (vla-get-TagString a) (vla-get-Constant a))) (apply 'append (mapcar 'cdr (GetBlock "BlockName" "*Attribute*"))))
; returns :
(("QTEMODULES" . :vlax-false) ("TYPEMODULE" . :vlax-true) ("REFINTERNE" . :vlax-false))

En théorie, chat respecte ton besoin d'être en Visual LISP, right ?
Pour ce qui est des tableaux, j'avoue que le domaine est encore un peu trop obscur pour moi >w<

Bisous,
Luna

[Fraid]

Ok, je vais étudier cela, 

mais tu avoueras que c'est tirer par les cheveux

pour moi, le fait que les restrictions incluse dans les dessins ne soit pas pris en compte en programmation est un bug...

quand j'ai testé avec, je m'attendais à une exception, pas une ignorance.

en tout cas merci, je vais voir si je peux appliquer ce principe aux tableaux. 

[Fraid]

J'ai fini par comprendre mon erreur pour les attributs constants

C'est dans la définition de block qu'il faut chercher

pas dans le block, cela doit être une erreur d'Autodesk d'avoir implanté cette propriété à l'objet block.

 

[Luna]

euhh......bah vui, c'est exactement de chat que l'on discutait hier ^^"

Il y a 18 heures, Luna a dit :

Coucou,

J'ai l'impression que la propriété "Constant" n'est pas récupérable depuis les objets ATTRIB (issus d'une référence de bloc) car la valeur est toujours 0 (= :vlax-false). En revanche, la valeur est différente en passant par les objets ATTDEF (issus d'une définition de bloc) ! Donc pour palier à ton problème, tu vas devoir récupérer la définition de bloc via (tblobjname), créer une boucle pour récupérer la liste des attributs via (entnext), correspondant du coup aux objets ATTDEF et non ATTRIB. Et seulement avec ces objets, tu pourras vérifier l'équation

(= (vla-get-Constant att) :vlax-false)

J'avoue être assez perplexe devant cette subtilité et je n'ai pas vraiment vérifié si cela est propre à la propriété "Constant" des attributs ou bien si l'ensemble des propriétés "Divers" sont comme cela...

Bisous,
Luna

Chat me semblait clair en l'écrivant xD

Par contre j'y comprends plus rien...en créant un nouveau bloc avec des attributs constants, cette fois-ci je peux savoir via la référence de bloc si les attributs sont constants ou non... >n<
Et ce, que la valeur de l'attribut soit un simple texte ou bien un champ dynamique ...donc il doit y avoir une explication logique et raisonnée, mais là comme chat j'ai un peu du mal à la voir

Bisous,
Luna

[Fraid]

Yop

Problème pour les attributs constant réglé (code modifié), merci Luna

Pour les tableaux, c'est quand je fouille dans les définitions de blocks que les objets du tableaux sont modifié.

dans cette partie

    ;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)
             (vlax-for obj  bl 
                    (delfield obj)
             )
        )
    )

les tableaux sont considéré comme des blocks

mais je ne trouve pas de propriété pour les discerner à ce niveau afin de les ignorer à cette étape.  

[Fraid]

j'ai trouvé une solution en passant par le nom du bloc,

un tableau est nommé comme un bloc anonyme avec un T (ex *T1)

donc avec 

(not (wcmatch (vla-get-name bl) "`*T*"))