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

Lisp Somme texte-attributs

jalna

Par jalna
dans Routines LISP

 Partager

Messages recommandés

jalna Newbie

jalna

Posté(e)
Posté(e)

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.....

"Je suis fasciné par l'air. Si on enlevait l'air du ciel, tous les oiseaux tomberaient par terre... Et les avions aussi... En même temps l'air tu peux pas le toucher... Ca existe et ça existe pas... Ca nourrit l'homme sans qu'il ait faim... It's magic ! L'air c'est beau en même temps tu peux pas le voir, c'est doux et tu peux pas le toucher... L'air, c'est un peu comme mon cerveau..."

J-C Van Damme

jalna Newbie

jalna

Posté(e)
  • Auteur
Posté(e)

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

"Je suis fasciné par l'air. Si on enlevait l'air du ciel, tous les oiseaux tomberaient par terre... Et les avions aussi... En même temps l'air tu peux pas le toucher... Ca existe et ça existe pas... Ca nourrit l'homme sans qu'il ait faim... It's magic ! L'air c'est beau en même temps tu peux pas le voir, c'est doux et tu peux pas le toucher... L'air, c'est un peu comme mon cerveau..."

J-C Van Damme

(gile) Proficient

(gile)

Posté(e)
Posté(e)

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

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

jalna Newbie

jalna

Posté(e)
  • Auteur
Posté(e)

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

"Je suis fasciné par l'air. Si on enlevait l'air du ciel, tous les oiseaux tomberaient par terre... Et les avions aussi... En même temps l'air tu peux pas le toucher... Ca existe et ça existe pas... Ca nourrit l'homme sans qu'il ait faim... It's magic ! L'air c'est beau en même temps tu peux pas le voir, c'est doux et tu peux pas le toucher... L'air, c'est un peu comme mon cerveau..."

J-C Van Damme

(gile) Proficient

(gile)

Posté(e)
Posté(e)

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.

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

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é