momooran2021

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)) ) "" ) )

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)) ) "" ) )

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)) ) "" ) )

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)) ) "" ) )

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)) ) "" ) )