Champ = somme des valeurs de champs

[(gile)]

Salut,

 

Suite à ce sujet, et comme la demande est récurrente, j'ai fait une routine plus aboutie qui insère un champ dont la valeur est égale à la somme des valeurs des champs sélectionnés dans des textes, mtextes ou attributs pouvant être imbriqués dans des blocs ou des tableaux.

 

EDIT : correction lapsus et mise en surbrillance des champs sélectionnés

 

;; ADDFIELDS (gile)
;; Insère un texte contenant un champ dynamique dont la valeur
;; est égale à la somme des valeurs des champs des textes, mtextes
;; ou attributs sélectionnés
;;
;; NOTA : aucun contrôle sur la conformité des champs sélectionnés
(defun c:AddFields (/ *error* ent lst res code pos ins)
 (vl-load-com)
 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "Erreur: " msg))
   )
   (mapcar (function (lambda (x) (redraw (car x) 4))) lst)
   (princ)
 )
 
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (while (setq ent (car (nentsel "\nSélectionnez un champ: ")))
   (if (and
         (setq code (gc:FieldCode ent))
         (setq pos (vl-string-search "%<" code))
         (setq code (substr code (1+ pos)))
         (setq pos (vl-string-position 37 code 1 T))
         (setq code (substr code 1 (1+ pos)))
       )
     (if (assoc ent lst)
(progn
  (setq lst (vl-remove (assoc ent lst) lst))
  (redraw ent 4)
)
(progn
  (setq lst (cons (cons ent code) lst))
  (redraw ent 3)
)
     )
     (princ "\nEntité non valide")
   )
 )
 (if (and lst
          (setq ins (getpoint "\nPoint d'insertion: "))
     )
   (progn
     (setq
       res (strcat "%<\\AcExpr "
                   (lst2str (mapcar 'cdr lst) " + ")
                   " "
                   (if (setq pos (vl-string-position (ascii "\\") code 1 T))
                     (substr code (1+ pos))
                     ">%"
                   )
           )
     )
     (mapcar (function (lambda (x) (redraw (car x) 4))) lst)
     (vla-addText
         (if (= 1 (getvar 'cvport))
           (vla-get-PaperSpace *acdoc*)
           (vla-get-ModelSpace *acdoc*)
         )
         res
         (vlax-3d-point (trans ins 1 0))
         (getvar 'textsize)
       )  
   )
 )
 (princ)
)
;;========================= ROUTINES =========================;;
;; 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 (<= n 57) 48 55)))
   )
 )
)
;;============================================================;;
;; 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 (vl-princ-to-string (car lst))
    sep
    (lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

[lecrabe]

 

Hello Gilles

 

Désolé mais j'ai l'erreur :

erreur: Le serveur ActiveX a renvoyé l'erreur: nom inconnu: ActiveSelectionSet

sur MAP 2006 et sur MAP 2008 :o

 

Le Decapode

 

[(gile)]

Oupss !

 

J'avais fait un lapsus : ActiveSelectionSet au lieu de ActiveDocument :P

C'est réparé.

[Invité ingoenius]

Merci Gile pour ce lisp, ça fonctionne parfait seul ic il faut selectionner les differents champs a addittionner un a la fois on il y a aussi une autre possibilité ?

 

;-)

 

[(gile)]

Oui, ici, mais ça ne fonctionne que pour les textes et mtextes non imbriqués (dans des blocs ou dans des tableaux).