Lisp Somme texte-attributs

[jalna]

Bonjour,

Gile à fait un lisp qui permet de faire une somme sur des champs

Quand je l'utilise, il me met la somme sous forme de dièses....

du style ####

Je retrouve aussi les dièses dans la formule

#### + #### + #### + ####

J’essaye de savoir pourquoi mais je sèche.....

[(gile)]

Salut,

 

Quel LISP ?

Quelle version d'AutoCAD ?

Quelle plateforme (32 ou 64 bits) ?

[jalna]

Salut

Pour le lisp

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

 

AutoCAD 2011

64Bits

[(gile)]

Salut,

 

Essaye celui-ci

 

;; 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)))
 )
 (or *util* (setq *util* (vla-get-Utility *acdoc*)))
 (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 (vla-get-ObjectId (vlax-ename->vla-object 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))))
 )
)

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

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

[jalna]

Salut

Merci ça fonctionne sauf que le résultat n'est pas la somme des champs (je penses aux arrondis......)

 

 

 

 

http://npic.imagup.com/2/1177048439.png

[(gile)]

Salut,

 

Effectivement le résultat du LISP est l'arrondi de la somme des aires, ce qui est plus précis mais peut différer de la somme des arrondis.

 

Exemple

30.256 -> arrondi à 30.26

10.637 -> arrondi à 10.64

4.841 -> arrondi à 4.84

 

somme des arrondis = 45.74

somme réelle = 45.734 arrondie à 45.73

 

On retrouve souvent ce genre de chose avec la somme de cotes continues et la cote globale qui diffèrent.