DenisHen Posté(e) le 21 juin 2022 Posté(e) le 21 juin 2022 Bonjour à la communauté. J'ai fais un lisp pour cumuler les longueurs des LWPOLYLINE. Si j'enlève le (cons 8 Calq), ça fonctionne, mais tout calques confondus. Si je le replace, je n'ai plus de calcul... Voici mon code : (defun MetreArmatTxt (/ MetreHaHo MetreNivHo MetreNbHo ArmatObj dxf_ent CalqObj Calq) (setq MetreHaHo "" i 0 HA6Tot 0.0 HA8Tot 0.0 HA10Tot 0.0 ;;;;;;; je n'ai pas tout collé HA40Tot 0.0 Text "" ) ;_ Fin de setq ;; Sélectionner le calque pour le calcul... (setq Obj (entget (car (entsel "\nSélectionner le calque pour le métré :")))) (setq Calq (cdr (assoc 8 Obj))) (princ (strcat "\nCalque du calcul : " Calq "\n")) (if (setq Select (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 Calq) (cons 410 "Model")))) ;;(cons 8 Calq) (progn (while (setq ent (ssname Select i)) ;;(princ "\nDrapeau 02") (setq MetreHaHo (vlax-ldata-get ent "MetreHAHo")) (setq MetreNivHo (vlax-ldata-get ent "MetreNivHo" "1")) (setq MetreNbHo (vlax-ldata-get ent "MetreNbHo")) ;;(princ "\nDrapeau 05") (if (/= MetreHaHo nil) (cond ((= MetreHaHo "HA6") (princ "\nDrapeau HA6") (setq HA6Tot (+ HA6Tot (* (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (atoi MetreNbHo)))) ;;(princ (strcat "\nHa=" MetreHaHo "\tNb=" MetreNbHo "\tNiveau=" MetreNivHo)) ) ((= MetreHaHo "HA8") (princ "\nDrapeau HA8") (setq HA8Tot (+ HA8Tot (* (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (atoi MetreNbHo)))) ;;(princ (strcat "\nHa=" MetreHaHo "\tNb=" MetreNbHo "\tNiveau=" MetreNivHo)) ) ((= MetreHaHo "HA10") (princ "\nDrapeau HA10") (setq HA10Tot (+ HA10Tot (* (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (atoi MetreNbHo)))) ;;(princ (strcat "\nHa=" MetreHaHo "\tNb=" MetreNbHo "\tNiveau=" MetreNivHo)) ) ;;;;;;;;;;;;;;;;;;;;;;;; je n'ai pas tout collé ((= MetreHaHo "HA40") (princ "\nDrapeau HA40") (setq HA40Tot (+ HA40Tot (* (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (atoi MetreNbHo)))) ;;(princ (strcat "\nHa=" MetreHaHo "\tNb=" MetreNbHo "\tNiveau=" MetreNivHo)) ) ) ;_ Fin de cond ) ;_ Fin de if (setq MetreHaHo nil) (setq i (1+ i)) ) ;_ Fin de while ) ;_ Fin de progn ) ;_ Fin de if (if (not (tblsearch "style" "ChainH")) (command "-style" "ChainH" "arial.ttf" "" "" "" "" "" "") (command "textstyle" "ChainH") ) ;_ Fin de if (setq NbDec (getvar "luprec")) ;;(setq Pt_ins_Txt (getpoint "\nPoint d'insertion du texte : ")) (setq Text "\\LLinéaire total des chaînages horizontaux :\\l\\P\\Q15(Hors recouvrement)\\Q0\\P") (if (/= HA6Tot 0) (setq Text (strcat Text "- HA6=" (rtos (/ HA6Tot 100) 2 NbDec) " m\n")) ) ;_ Fin de if (if (/= HA8Tot 0) (setq Text (strcat Text "- HA8=" (rtos (/ HA8Tot 100) 2 NbDec) " m\n")) ) ;_ Fin de if (if (/= HA10Tot 0) (setq Text (strcat Text "- HA10=" (rtos (/ HA10Tot 100) 2 NbDec) " m\n")) ) ;_ Fin de if ;;;;;;;;;;;;;;;;;;;;;;;; je n'ai pas tout collé (if (/= HA40Tot 0) (setq Text (strcat Text "- HA40=" (rtos (/ HA40Tot 100) 2 NbDec) " m")) ) ;_ Fin de if (princ) ) Quelqu'un pourrait me dire où j'ai fais une erreur ? Windows 11 / AutoCAD 2024 Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net). Davantage d'avantages, avantagent davantage (Bobby Lapointe). La connaissance s'accroît quand on la partage (Socrate). Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)
Luna Posté(e) le 21 juin 2022 Posté(e) le 21 juin 2022 (modifié) Coucou, Serait-il possible d'avoir un .dwg d'exemple pour voir pour quelle raison cela ne fonctionne pas ? Si je comprends bien, c'est le (cons 8 Calq) qui pose un souci dans le filtre (ssget) ? Autrement, je pense que l'écriture du programme pourrait être grandement simplifiée en évitant de créer un ligne pour chaque valeur possible...J'avais créé 2 fonctions pour créer une liste d'association à plusieurs niveaux (il me manque encore la dernière pour pouvoir l'interpréter malheureusement...). Pour ton cas, la seconde fonction ne te servira à rien car elle ne permet pas encore de gérer les données étendues ou XDatas... Cependant tu peux essayer de voir avec la 1ère : ; +-----------------------------------------------------------------------------------------------------------------------------------------------+ ; ; | | ; ; | HISTORICAL TRACKING FILE OF THE FUNCTION | ; ; | --{ make-a-list-properties }-- | ; ; | | ; ; +-----------------------------------------------------------------------------------------------------------------------------------------------+ ; ; []-----------------------[] make-a-list-properties []-----------------------[] ; ;--- Date of creation > 06/01/2022 ; ;--- Last modification date > 04/02/2022 ; ;--- Author > Luna ; ;--- Version > 2.0.0 ; ;--- Class > "BaLst" ; ;--- Goal and utility of the main function ; ; When used in a loop function and by defining the 'lst' variable with the result of this function, it creates an association list with different ; ; levels. The main idea is to set value (like a counter, the object's length, etc.) and creates a new list of keys if not existant or applies a ; ; function (like '+, '-, 'strcat) between the old and the new value with the same list of keys. For that, it will considered for each key a new ; ; level of association list. In fine, each similar objects by the value of their properties name, will be match together. ; ; ; ;--- Declaration of the arguments ; ; The function (make-a-list-properties) have 5 argument(s) : ; ; --• lst > corresponds to the existing list you want to build withing a loop. The common use will be, for example, see below ; ; (setq lst (make-a-list-properties lst ...)) ; ; (type lst) = 'LST | Ex. : a variable name to build the list within a loop ; ; --• k-lst > corresponds to the list of property value that will be used to determine the number of level of association list. ; ; Each property value will be used as the key for each association list. ; ; (type k-lst) = 'LST | Ex. : '("Layer1" "LWPOLYLINE"), '("BlockName2" "63,115,69" "23.42"), '("Layer0"), ... ; ; --• value > corresponds to the new value for the list of keys. If the 'lst' already contain a value for that list of keys, it ; ; will be add to the old one (depending of 'fun' value), otherwise it will be add to the list with the list of keys ; ; (type value) = '... | Ex. : 1 (to count the entity units), (getpropertyvalue name "LENGTH"), "63,115,69", ... ; ; --• fun > corresponds to the function that will be used to connect the old value with the new one. The most common value of ; ; 'fun' is '+, to add the new value with the old one ; ; (type fun) = 'SYM | Ex. : '+, '-, 'strcat, ... ; ; --• flag > corresponds to the position of 'value' in relation to (cdr search), the actual value in the association list ; ; (type flag) = 'SYM | Ex. : T means 'value' is before (cdr search), nil means 'value' is after (cdr search) ; ; ; ;--- List of dependent's functions ; ; --• "XxXxx" ---> ... | v#.#.# - ##/##/#### (Luna) ; ; ; ;--- List of local functions ; ; --• "XxXxx" ---> ... | v#.#.# - ##/##/#### (Luna) ; ; ; ;--- List of programs using this function ; ; --• "BaLst" ---> loop-a-list-properties | v2.0.0 - 28/02/2022 (Luna) ; ; ; ;--- Return ; ; The function (make-a-list-properties) returns the new value of the list, with the new value substitute to the old one if existing, or add it to ; ; the list. ; ; Ex. : (make-a-list-properties lst (list Layer ObjectName) 1 '+ nil) returns after the loop from a selection set ; ; ( ("Layer1" ("LWPOLYLINE" . 13) ("CIRCLE" . 4) ("INSERT" . 1)) ; ; ("Layer3" ("CIRCLE" . 1) ("LINE" . 14) ("LWPOLYLINE" . 42)) ; ; ("Layer2" ("INSERT" . 69)) ; ; ("Layer9" ("LINE" . 3) ("ARC" . 11)) ; ; ) ; ; ; ;--- Historic list of the version with their modification status ; ; +------------+----------------------------------------------------------------------------------------------------------------------------------+ ; ; | v2.0.0 | Adding an argument to define the position of 'value' (cdr search) in the list between each other | ; ; | | (i.e (list value (cdr search)) or (list (cdr search) value)) to adapt the program to different function (like (cons) and (-)) | ; ; +------------+----------------------------------------------------------------------------------------------------------------------------------+ ; ; | v1.0.0 | Creation of the function | ; ; +------------+----------------------------------------------------------------------------------------------------------------------------------+ ; ; ; (defun make-a-list-properties (lst k-lst value fun flag / key search) (if (null (cdr k-lst)) (if (setq search (assoc (setq key (car k-lst)) lst)) (subst (cons key (apply fun (if flag (list value (cdr search)) (list (cdr search) value)))) search lst) (append lst (list (cons key value))) ) (if (setq search (assoc (setq key (car k-lst)) lst)) (subst (cons key (make-a-list-properties (cdr search) (cdr k-lst) value fun flag)) search lst) (append lst (list (cons key (make-a-list-properties (cdr search) (cdr k-lst) value fun flag)))) ) ) ) Pour ton utilisation, je peux te suggérer un programme de ce genre (à compléter et tester !) : (defun foo (layer / jsel i name HaHo NvHo NbHo Lght lst text) (if (setq jsel (ssget "_X" (list '(0 . "LWPOLYLINE") (cons 8 layer) '(410 . "Model")))) (progn (repeat (setq i (sslength jsel)) (and (setq name (ssname jsel (setq i (1- i)))) (setq HaHo (vlax-ldata-get name "MetreHaHo")) (setq NvHo (vlax-ldata-get name "MetreNivHo" "1")) (setq NbHo (vlax-ldata-get name "MetreNbHo")) (setq Lgth (getpropertyvalue name "LENGTH")) (setq lst (make-a-list-properties lst (list HaHo) (* Lgth (cond ((distof NbHo)) (1))) '+ nil)) ) ) (setq text "\\lLinéaire total des chaînages horizontaux :\\l\\P\\Q15(Hors recouvrement)\\Q0\\P") ; (foreach x (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))) ; (setq text ; (strcat ; text ; "- " ; (car x) ; "=" ; (rtos (/ (cdr x) 100) 2) ; " m\n" ; ) ; ) ; ) (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))) ) ) ) Bisous, Luna Modifié le 21 juin 2022 par Luna Correction du programme (foo) 1
DenisHen Posté(e) le 21 juin 2022 Auteur Posté(e) le 21 juin 2022 Bonjour Luna, et merci pour ton aide. Je vais regarder ton code avec le plus grand intérêt. Voici mon DWG. CadXP_(cons 8 Calq).zip Windows 11 / AutoCAD 2024 Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net). Davantage d'avantages, avantagent davantage (Bobby Lapointe). La connaissance s'accroît quand on la partage (Socrate). Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)
DenisHen Posté(e) le 21 juin 2022 Auteur Posté(e) le 21 juin 2022 Je viens d'essayer avec ton (ssget : (if (setq Select (ssget "_X" (list '(0 . "LWPOLYLINE") (cons 8 layer) '(410 . "Model")))) Et AutoCAD me répond : Citation ; erreur: valeur de liste SSGET incorrecte Et je n'arrive à rien avec (lambda et (mapcar, j'aurais du mal à retoucher ton code. 😪 Windows 11 / AutoCAD 2024 Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net). Davantage d'avantages, avantagent davantage (Bobby Lapointe). La connaissance s'accroît quand on la partage (Socrate). Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)
Luna Posté(e) le 21 juin 2022 Posté(e) le 21 juin 2022 Oki doki !! Alors vui, j'ai oublié de préciser mais (foo) possède le nom du calque en argument donc pour l'exemple tu pourrais avoir : (foo (cdr (assoc 8 (entget (car (entsel)))))) Ensuite j'ai compris d'où provient le problème 😉 C'est le nom de ton calque qui ne plaît pas au (ssget) 🙂 J'ai essayé avec un autre calque et il n'y a plus de problème J'ai modifié (foo) sur mon post précédent en corrigeant les erreurs détectées en le testant sur ton .dwg ^^ Pour ce qui est du nom du calque, je vais essayer de voir ce qu'on peut faire mais le soucis vient de là (Wildcard Characters) : https://knowledge.autodesk.com/support/autocad-map-3d/learn-explore/caas/CloudHelp/cloudhelp/2019/ENU/MAP3D-Use/files/GUID-BED8F649-3D1A-4641-A48F-562A2EBB927C-htm.html Bisous, Luna 1
DenisHen Posté(e) le 21 juin 2022 Auteur Posté(e) le 21 juin 2022 Un milliard de merci, je ne comprenais plus rien ! ! ! Je pensais avoir fais une bêtise. Heureusement il y a CadXP et ses merveilleux membres ! ! ! Encore merci Luna. Windows 11 / AutoCAD 2024 Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net). Davantage d'avantages, avantagent davantage (Bobby Lapointe). La connaissance s'accroît quand on la partage (Socrate). Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)
Luna Posté(e) le 21 juin 2022 Posté(e) le 21 juin 2022 Je peux proposer ceci pour le nom du calque : (defun read-str ( str / wcc ) (setq wcc '("#" "@" "." "*" "%" "?" "~" "[" "]" "-" "`" ",")) (setq str (mapcar 'chr (vl-string->list str))) (apply 'strcat (mapcar '(lambda (s) (if (member s wcc) (strcat "`" s) s ) ) str ) ) ) Ainsi il suffirait de remplacer (cons 8 layer) par (cons 8 (read-str layer)) A tester si avec ton programme et/ou mon bout de programme il y a 16 minutes, DenisHen a dit : Un milliard de merci, je ne comprenais plus rien ! ! ! Je pensais avoir fais une bêtise. Heureusement il y a CadXP et ses merveilleux membres ! ! ! Encore merci Luna. Tout le plaisir est pour moi :3 Bisous, Luna 1
DenisHen Posté(e) le 21 juin 2022 Auteur Posté(e) le 21 juin 2022 Merci pour ton aide, mais j'avais déjà dis à mes collègues de ne pas mettre de caractères spéciaux dans les noms des calques (ni ailleurs Styles de texte, de ligne, de côtes...) Je vais corrigé ces noms... Encore merci à toi... Windows 11 / AutoCAD 2024 Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net). Davantage d'avantages, avantagent davantage (Bobby Lapointe). La connaissance s'accroît quand on la partage (Socrate). Tant va la cruche à l'eau que l'habit n'amasse pas mousse avant de l'avoir tué. (Moi)
Messages recommandés
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 compteSe connecter
Vous avez déjà un compte ? Connectez-vous ici.
Connectez-vous maintenant