Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Peut-on changer le format de champ de plusieurs attributs à la fois ?

brunomu

Par brunomu
dans AutoCAD 2010

 Partager

Messages recommandés

brunomu Newbie

brunomu

Posté(e)
Posté(e)

Je m’explique : j’ai, dans un plan, une polyligne par contour de pièce, et un attribut pour indiquer la surface de chaque pièce (et aussi pas mal d’autres données).

 

Comme j’ai appris à me servir des champs, je souhaite affecter à un des attributs la valeur du champ « area » (désolé, je travaille en anglais) de l’objet polyligne correspondant.

Je suis donc obligé de remplacer manuellement la valeur de l’attribut par un champ et de le lier à une polyligne, pièce par pièce.

En revanche, j’aimerais bien ne pas avoir à préciser, à chaque fois, le format de chaque champ (facteur d’échelle car je dessine en cm mais je veux indiquer les surfaces en m², nombre de décimales, suffixe « m² »).

Existe-t-il un moyen de copier le format d’un champ d’un attribut dans un autre ?

(j’ai essayé avec la commande ATTSYNC, mais ça ne marche pas…).

 

D'avance, merci pour votre aide !

 

[Edité le 23/7/2010 par gloub]

bryce Newbie

bryce

Posté(e)
Posté(e)

Bonjour,

 

J'ai déjà cherché, et apparemment il n'y a pas d'autre moyen que le LISP...

 

Comme mes connaissances en LISP se limitent à bidouiller un peu des routines écrites par d'autres, j'ai cherché sur le net et j'ai trouvé ça:

http://www.cadtutor.net/forum/showthread.php?31029-Insert-An-Attribute-Block-Then-Fill-In-w-Field

http://www.cadtutor.net/forum/showthread.php?47834-Get-ObjectID-for-Attdef-script

 

J'ai modifié un peu ces 2 LISP pour faire la conversion d'unités dont tu as besoin.

Avec le premier, le bloc contenant l'attribut doit déjà être inséré, et il faut cliquer sur la polyligne puis sur l'attribut qui doit afficher la surface.

 

(defun c:arf(/ fStr cObj vObj cTxt vTxt)

(vl-load-com)

(if
(and
(setq cObj(entsel "\nChoix de l'objet à mesurer: "))
(vlax-property-available-p
(setq vObj(vlax-ename->vla-object(car cObj))) 'Area)
); end and
(if
(and
(setq cTxt(nentsel "\nChoix du Texte, Texte multiligne ou Attribut pour l'affichage de l'aire "))
(vlax-property-available-p
(setq vTxt(vlax-ename->vla-object(car cTxt))) 'TextString)
); end and
(progn
(vla-put-TextString vTxt
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa(vla-get-ObjectID vObj)) ">%).Area \\f \"%lu2%pr2%ps[,m²]%ds44%zs8%ct8[0.0001]\">%"))
); end progn
); end if
); end if
(princ)
); end of c:arf

 

Avec celui-ci, il faut cliquer sur la polyligne et le bloc est inséré automatiquement.

Il faut par contre renseigner dans le code le nom du bloc, ainsi que l'étiquette de l'attribut qui doit afficher la surface (attention aux majuscules).

 

(defun c:AreaBlk ( / GetBlock GetObjectID PutAttValue InsertBlock
                BOBJ DOC ENT FBLOCK FTAG OBJ PT RESULT SPC TAG VALUE)
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10
 

 (setq fBlock "aire")   ;; Nom du bloc à insérer (ou nil)

 (setq ftag  "AIRE")   ;; Etiquette de l'attribut qui affichera la surface
 

 (defun GetBlock ( block )
 ;; Lee Mac  ~  05.05.10
   (cond
     (
       (not
         (and
           (or block
             (setq block
               (getfiled "Select Block" "" "dwg" 16)
             )
           )
           (or
             (and
               (vl-position
                 (vl-filename-extension block) '("" nil)
               )
               (or
                 (tblsearch "BLOCK" block)
                 (setq block
                   (findfile
                     (strcat block ".dwg")
                   )
                 )
               )
             )
             (setq block (findfile block))
           )
         )
       )
      nil
     )
     ( block )
   )
 )

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 

 (if (setq fBlock (GetBlock fBlock))
   
   (while
     (progn
       (setq ent (car (entsel "\nChoix de l'objet à mesurer: ")))

       (cond
         (
           (eq 'ENAME (type ent))

           (if
             (not
               (vlax-property-available-p
                 (setq obj (vlax-ename->vla-object ent)) 'Area
               )
             )
             (princ "\n** Objet incorrect **")
             
             (if
               (and
                 (setq pt (getpoint "\nSpécifiez le point d'insertion du bloc: "))
                 (setq bObj (InsertBlock spc fBlock pt))
               )
               (progn
                 (and ftag
                   (PutAttValue bObj ftag
                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID obj doc) ">%).Area \\f \"%lu2%pr2%ps[,m²]%ds44%zs8%ct8[0.0001]\">%"
                     )
                   )
                 )
                 (vla-regen doc acActiveViewport)
               )
             )
           )
         )
       )
     )
   )
   (princ "\n** Bloc non trouvé **")
 )
 (princ)
)

 

 

 

[Edité le 23/7/2010 par bryce]

Brice, formateur AutoCAD - Inventor - SolidWorks - ZWCad - DraftSight - SketchUp indépendant

(gile) Proficient

(gile)

Posté(e)
Posté(e)

Salut,

 

Un LISP qui copie le format d'un champ source (texte, mtexte ou attribut) pour chaque champ cible sélectionné.

 

Les champ cible doivent être sélectionnés un par un (obligatoire pour les attributs) et doivent être du même type que le champ source (le LISP ne vérifie pas)

 

(defun c:CopyFieldFormat (/ source fieldCode format target)
 (vl-load-com)
 (and
   (setq source (car (nentsel "\nSélectionnez le champ source: ")))
   (setq fieldCode (gc:FieldCode source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (while (setq target (car (nentsel "\nSélectionnez un champ cible ou  ")))
     (if (setq fieldCode (gc:FieldCode target))
       (progn
         (setq target (vlax-ename->vla-object target))
         (vla-put-TextString target "")
         (vla-put-TextString
           target
           (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode))
                   format
           )
         )
       )
     )
   )
 )
 (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
 (princ)
)

;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte
;; avec le(s) code(s) de champ(s)
;;
;; Argument : nom d'entité de l'objet (ENAME)

(defun gc:FieldCode (ent / foo elst xdict dict field str)

 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
     (while (setq pos (vl-string-search "\\_FldIdx " str pos))
       (setq fldId (entget (cdr (assoc 360 field)))
             field (vl-remove (assoc 360 field) field)
             str   (strcat
                     (substr str 1 pos)
                     (if (setq objID (cdr (assoc 331 fldId)))
                       (vl-string-subst
                         (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                         "ObjIdx"
                         (cdr (assoc 2 fldId))
                       )
                       (foo fldId (cdr (assoc 2 fldId)))
                     )
                     (substr str (1+ (vl-string-search ">%" str pos)))
                   )
       )
     )
     str
   )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
(setq xdict (cdr (assoc 360 elst)))
(setq dict (dictsearch xdict "ACAD_FIELD"))
(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
   (setq str (foo field (cdr (assoc 2 field))))
 )
)

;;============================================================;;

;; gc:EnameToObjectId (gile)
;; Retourne l'ObjectID correspondant à un ename
;;
;; Argument : un ename

(defun gc:EnameToObjectId (ename)
 ((lambda (str)
    (hex2dec
      (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
    )
  )
   (vl-princ-to-string ename)
 )
)

;;============================================================;;

;; hex2dec (gile)
;; conversion hexadécimal -> décimal
;;
;; Argument : un hexadédimal (chaîne)

(defun hex2dec (s / r l n)
 (setq	r 0 l (vl-string->list (strcase s)))
 (while (setq n (car l))
   (setq l (cdr l)
         r (+ (* r 16) (- n (if (    )
 )
)

;;============================================================;;

;; lst2str (gile)
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur

(defun lst2str (lst sep)
 (if (cdr lst)
   (strcat (car lst) sep (lst2str (cdr lst) sep))
   (car lst)
 )
)

;;============================================================;;

  • Like 1

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

  • 1 an après...
krunch Newbie

krunch

Posté(e)
Posté(e) (modifié)

Bonjour

 

J'ai repris cette fonction de (gile) pour la mettre au gout du jour (64 bits) ET en ajouter une nouvelle : la possibilité de ré-affecter l'objet d'un champ d'objet (typiquement : polylignes de surfaces), par exemple si il a été supprimé... C'est la commande EditFieldObject : sélection d'un champ d'objet puis d'un objet

 

Pour ça, j'avoue j'ai opté pour une méthode de fainéant : l'ajout d'un argument (le nouvel Id) à la fonction gc:FieldCode de (gile) (sans avoir vraiment pris le temps de la décrypter :huh: ) ..

 

Juste une remarque : avec des textes multilignes CopyFieldFormat copie tout le texte placé après le champ d'objet, ce qui peut être gênant.

 

Sinon (d'après d'autres discussions) le regen final a l'air indispensable avec les références d'attribut (?), dans ces codes j'ai mis un test

 

Voilà, merci à (gile)

 

 

; EditFieldObject : Affecte un nouvel objet à un champ d'objet
; Note : affecte tous les champs d'objets des MText (plusieurs champs possibles)

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet
   (vl-string-search "ObjId" format)
   (setq source (car (nentsel "\nSélectionnez le nouvel objet : ")))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
   )
 )
 (vla-endundomark acdoc)
 (princ)
)


; CopyFieldFormat (gile) : copie le format d'un champ vers un autre

; source	champ source du format à copier
; target	champ modifié
(defun c:CopyFieldFormat (/ source fieldCode format target acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq source (car (nentsel "\nSélectionnez le champ source : ")))
   (setq fieldCode (gc:FieldCode source nil))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (while (setq target (car (nentsel "\nSélectionnez un champ cible : ")))
     (if (setq fieldCode (gc:FieldCode target nil))
       (progn
         (setq target (vlax-ename->vla-object target))
         (vla-put-TextString target "")
         (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
       )
     )
   )
   (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
 )
 
 (vla-endundomark acdoc)
 (princ)
)


;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

Modifié par krunch
  • 10 ans après...
momooran2021 Newbie

momooran2021

Posté(e)
Posté(e)

petite amélioration pour la prise en charge des multileader. merci pour le partage. 

; EditFieldObject : Affecte un nouvel objet à un champ d'objet
; Note : affecte tous les champs d'objets des MText (plusieurs champs possibles)

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet
   (vl-string-search "ObjId" format)
   (setq source (car (nentsel "\nSélectionnez le nouvel objet : ")))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
   )
 )
 (vla-endundomark acdoc)
 (vla-Regen acdoc acActiveViewport)
 (princ)
)


; CopyFieldFormat (gile) : copie le format d'un champ vers un autre

; source	champ source du format à copier
; target	champ modifié
(defun c:CopyFieldFormat (/ source fieldCode format target acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq source (car (nentsel "\nSélectionnez le champ source : ")))
   (setq fieldCode (gc:FieldCode source nil))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (while (setq target (car (nentsel "\nSélectionnez un champ cible : ")))
     (if (setq fieldCode (gc:FieldCode target nil))
       (progn
         (setq target (vlax-ename->vla-object target))
         (vla-put-TextString target "")
         (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
       )
     )
   )
   (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
 )
 
 (vla-endundomark acdoc)
 (princ)
)


;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

 

momooran2021 Newbie

momooran2021

Posté(e)
Posté(e)

une autre amélioration avec le réassociation des multileader avec l'objet source. 

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq p (getpoint "\nSélectionnez le nouvel objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet   
   (vl-string-search "ObjId" format)
   (setq source (car (nentselp p)))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))   
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
   )
 )
 (setq target (vlax-vla-object->ename target))
  (setq elst (entget target))
  (if (member (cdr (assoc 0 elst)) '("MULTILEADER"))
     (vl-cmdf "COTREASSOCIER" target "" p "")
  )
 (vla-endundomark acdoc)
 (vla-Regen acdoc acActiveViewport)
 (princ)
)
;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

 

momooran2021 Newbie

momooran2021

Posté(e)
Posté(e)

version final, sans message d'erreur en cas de selection autre que les type d'objet text, mtext..etc. 

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet   
   (vl-string-search "ObjId" format)
   (setq p (getpoint "\nSélectionnez le nouvel objet : "))
   (setq source (car (nentselp p)))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))   
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (= (vla-get-objectname target) "AcDbAttribute") (vla-Regen acdoc acActiveViewport))
     (setq target (vlax-vla-object->ename target))
     (setq elst (entget target))
     (if (member (cdr (assoc 0 elst)) '("MULTILEADER")) (vl-cmdf "COTREASSOCIER" target "" p ""))
   )
 )
 (vla-endundomark acdoc)
 (vla-Regen acdoc acActiveViewport)
 (princ)
)
;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

 

momooran2021 Newbie

momooran2021

Posté(e)
Posté(e)

révision du code suite a des message d'erreur. 

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet   
   (vl-string-search "ObjId" format)
   (setq p (getpoint "\nSélectionnez le nouvel objet : "))
   (setq source (car (nentselp p)))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))   
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (or (= (vla-get-objectname target) "AcDbAttribute") (= (vla-get-objectname target) "AcDbMLeader"))
       (vla-Regen acdoc acActiveViewport))
     (setq target (vlax-vla-object->ename target))
     (setq elst (entget target))
     (if (member (cdr (assoc 0 elst)) '("MULTILEADER"))
       (and
        (vl-cmdf "COTREASSOCIER" target "" p)
        )
     )
   )
 )
 (vla-endundomark acdoc)
 (princ)
)
;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

 

momooran2021 Newbie

momooran2021

Posté(e)
Posté(e)

modification pour prise en charge multilingues. 

; source	entité affectée au champ
; target	champ modifié
(defun c:EditFieldObject (/ target fieldCode format source acdoc)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-startundomark acdoc)
 (and
   (setq target (nentselp "\nSélectionnez un champ d'objet : "))
   (setq target (car target))
   (setq format (gc:FieldCode target nil)) ; temporaire pour test si champ d'objet   
   (vl-string-search "ObjId" format)
   (setq p (getpoint "\nSélectionnez le nouvel objet : "))
   (setq source (car (nentselp p)))
   (setq fieldCode (gc:FieldCode target source))
   (setq format (substr fieldCode (1+ (vl-string-search "\\f" fieldCode))))
   (setq target (vlax-ename->vla-object target))   
   (progn
     (vla-put-TextString target "")
     (vla-put-TextString target (strcat (substr fieldCode 1 (vl-string-search "\\f" fieldCode)) format))
     (if (or (= (vla-get-objectname target) "AcDbAttribute") (= (vla-get-objectname target) "AcDbMLeader"))
       (vla-Regen acdoc acActiveViewport))
     (setq target (vlax-vla-object->ename target))
     (setq elst (entget target))
     (if (member (cdr (assoc 0 elst)) '("MULTILEADER"))
       (and
        (vl-cmdf "_COTREASSOCIER" target "" p)
        )
     )
   )
 )
 (vla-endundomark acdoc)
 (princ)
)
;; gc:FieldCode (gile)
;; Retourne la chaîne de caractère d'un attribut, texte ou mtexte avec le(s) code(s) de champ(s)

; ent	ENAME		Nom d'entité de l'objet
; obj	ENAME/nil	Nouvelle entité à affecter au code de champ(s) d'objet / entité déjà affectée
(defun gc:FieldCode (ent obj / foo elst xdict dict field str)
 
 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
       ; Itération des champs de str
       (while (setq pos (vl-string-search "\\_FldIdx " str pos))
         (setq fldId (entget (cdr (assoc 360 field)))
               field (vl-remove (assoc 360 field) field)
               str   (strcat
                       (substr str 1 pos)
                       (if (setq objID (cdr (assoc 331 fldId)))
		    ; champ d'objet
                           (vl-string-subst (strcat "ObjId " (GetObjectID (if obj obj objID))) "ObjIdx 0" (cdr (assoc 2 fldId)))
		    ; champ d'envrnt
                           (foo fldId (cdr (assoc 2 fldId)))
                       )
                       (substr str (1+ (vl-string-search ">%" str pos)))
                     )
         )
       )
       str
     )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
       (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
       (setq xdict (cdr (assoc 360 elst)))
       (setq dict (dictsearch xdict "ACAD_FIELD"))
       (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
     (setq str (foo field (cdr (assoc 2 field))))
 )
)

; Renvoie ObjectID (string) de ent / "" si objet supprimé
(defun GetObjectID (ent / div err)
 (setq ent (if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))) nil err))
 (if ent
     (if (vlax-method-applicable-p (vla-get-Utility acdoc) 'GetObjectIdString)
(vla-GetObjectIdString (vla-get-Utility acdoc) ent :vlax-false)
(itoa (vla-get-ObjectId ent))
     )
     ""
 )
)

 

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité