Test contrôle d'attribut de bloc en doublon

JPhil · le 4 février 2022

Je beug complet sur la fin d'un programme de test/contrôle.

Voici le début du programme :

;;;
;;; source : https://cadxp.com/topic/28984-trie-interrogations-vl-sort-list-compaison-function/
;;;
;;; Affiche une liste qui contient le nombre de doublon d'une liste
(defun sub (lst n)
   (if    (cadr lst)
     (if (equal (car lst) (cadr lst))
   (sub (cdr lst) (1+ n))
   (cons (cons n (car lst)) (sub (cdr lst) 1))
     )
     (list (cons n (car lst)))
   )
)
;;;

;;;
;;; (setq lst '("IEF-01-VEI" "IEF-01-VEI" "IEF-02-VEI" "IEF-03-VEI" "IEF-04-VEI" "IEF-04-VEI" "IEF-04-VEI" "IEF-05-VEI"))
;;; 
;;; Affiche uniquement la liste des doublons du programme "sub"
(defun sub2 (lst)
   (setq lst (sub lst 1))
   (setq nblst (length lst))
   (setq newlst nil)
   (setq toto 0)
   (while (> nblst toto)
      (if (> (car (nth toto lst)) 1)
         (setq newlst (cons (nth toto lst) newlst))
      )
      (setq toto (+ 1 toto))
   )
   (reverse newlst)
)
;;;

;;; 
;;; (tri txtCDVPK (cdr (nth toto (sub2 txtCDV))))
;;; 
(defun tri (lst arg / newlst)
   (setq toto 0)
   (while (> (length lst) toto)
      (if (= (substr (nth toto lst) 1 (strlen arg)) arg)
         (setq newlst (cons (nth toto lst) newlst))
      ) ; fin if
      (setq toto (+ 1 toto))
   ) ; fin while toto
   (reverse newlst)
)
;;; 

(defun c:TestControle ()
(setq toto 0)
(setq ent nil)
(setq nbCDV nil)
(setq txtCDV nil)
(setq txtCDVPK nil)
(setq CaptureCDV nil)
(setq CaptureCDV (ssget "_X" (list '(0 . "INSERT") (cons 2 "JOINT_VOIE*"))))
(setq nbCDV (sslength CaptureCDV))
(while (> nbCDV toto)
   (setq ent (ssname CaptureCDV toto))
(if (= (strcase (substr (getpropertyvalue ent "NUMCDV") 1 3)) "CDV")
   (progn
   (setq txtCDV (cons (getpropertyvalue ent "NUMCDV") txtCDV))
   (setq txtCDVPK (cons (strcat (getpropertyvalue ent "NUMCDV") " au PK " (getpropertyvalue ent "PKT")) txtCDVPK))
   )
)
   (setq toto (+ 1 toto))
)
(setq txtCDV (vl-sort txtCDV '<))
(setq txtCDVPK (vl-sort txtCDVPK '<))

;;; Résultat d'un extrait des listes
;;; txtCDV --> ("cdv 231A" "cdv 231B" "cdv 233" "cdv 235" "cdv 237A" "cdv 237B" "...")
;;; (sub2 txtCDV) --> ((3 . "cdv 461B") (2 . "cdv 466") (2 . "cdv 468A") (2. "..."))
;;; txtCDVPK --> ("cdv 231A au PK 3.173A" "cdv 231B au PK 3.092A" "cdv 233 au PK 3.022A" "cdv 235 au PK 2.936A" "cdv 237A au PK 2.870A" "cdv 237B au PK 2.791A" "... au PK ...")

;;; cette partie que j'essaye de passer en mode totomatique
;;; (setq toto 5)
;;; (tri txtCDVPK (cdr (nth toto (sub2 txtCDV))))
;;; fin de la partie en mode totomatique

) ; fin defun

Voici la partie où je beug :

(setq toto 5)
(tri txtCDVPK (cdr (nth toto (sub2 txtCDV))))

En mode manuel (remplacer la valeur de toto par n'importe quel nombre) ça fonctionne super, mais en mode totomatique avec un while classique comme ça :

(setq toto 0)
(setq resultat nil)
(while (> (length (sub2 txtCDV)) toto)
(setq resultat (cons (tri txtCDVPK (cdr (nth toto (sub2 txtCDV)))) resultat))
(setq toto (+ 1 toto))
)

Chat marche pas.
Je dois louper un truc.
Pourtant j'suis pas loin du but.
Merci d'avance pour votre aide.

Luna · le 4 février 2022

Coucou,

J'ai du mal à comprendre le fonctionnement de tes fonctions (sub) et (sub2) par rapport au texte écrit en commentaire...
Par exemple (sub) fonctionne avec ta liste

(setq lst '("IEF-01-VEI" "IEF-01-VEI" "IEF-02-VEI" "IEF-03-VEI" "IEF-04-VEI" "IEF-04-VEI" "IEF-04-VEI" "IEF-05-VEI"))

(sub lst 1) returns
((2 . "IEF-01-VEI") (1 . "IEF-02-VEI") (1 . "IEF-03-VEI") (3 . "IEF-04-VEI") (1 . "IEF-05-VEI"))

Mais si on prend une liste non triée :

(setq lst '(0 1 2 3 4 5 4 6 5 1 6 7 7 9 2 1 5 3 4))

(sub lst 1) returns
((1 . 0) (1 . 1) (1 . 2) (1 . 3) (1 . 4) (1 . 5) (1 . 4) (1 . 6) (1 . 5) (1 . 1) (1 . 6) (2 . 7) (1 . 9) (1 . 2) (1 . 1) (1 . 5) (1 . 3) (1 . 4))

Or si on s'en tient à ton commentaire

Citation

;;; Affiche une liste qui contient le nombre de doublon d'une liste

Bah je devrais plutôt obtenir ce résultat :

((1 . 0) (3 . 1) (2 . 2) (2 . 3) (3 . 4) (3 . 5) (2 . 6) (2 . 7) (1 . 9))

Donc la fonction serait plus quelque chose dans le genre :

(defun sub (lst / tmp)
  (if (setq tmp (vl-remove (car lst) lst))
    (cons (cons (- (length lst) (length tmp)) (car lst)) (sub tmp))
    (list (cons (length lst) (car lst)))
  )
)

Donc ensuite, si je comprends bien ton (sub2) correspond à un

(vl-remove-if '(lambda (x) (= (car x) 1)) lst)

car il supprime tout ce qui n'apparaît qu'une seule fois dans ta liste de départ (en prenant dans l'exemple ci-dessus que 'lst' correspond au résultat de (sub) !). La fonction tri permet si je comprends bien, de récupérer la liste des chaînes de caractères qui possèdent une chaîne de caractères spécifique en début de chaîne (nommée 'arg').
Cependant ce que je n'arrive pas à comprendre c'est la finalité du programme... Que désires-tu exactement ? A quoi correspondent les fonctions (sub) et (sub2) ?

Il y a trop de variables pour que mon cerveau arrive à suivre pour le coup >w<

Bisous,
Luna

JPhil · le 4 février 2022

@Luna,

La finalité du programme est la suivante : faire apparaitre les doublons et dire où ils se trouvent.

J'ai des blocs "JOINT_VOIE*" avec l'attribut "NUMCDV" dont la valeur est "cdv ...".
Normalement cette valeur doit être unique, d'où l'idée du programme.

La fonction sub permet de dire le nombre doublon pour chaque valeur.
La fonction sub2 permet de garder que les doublons et d'effacer le reste c'est à dire les valeurs uniques.
Comme tu as pu le remarquer la liste pour la fonction sub doit être triée.

J'ai créé sub2 pour un autre programme (d'où les "IEF-01-VEI" en commentaire que j'aurais pu effacer), donc je le réutilise pour celui-ci.
J'aurais pu le modifier pour ne faire apparaitre que la valeur en supprimant le nombre de doublon :

(setq newlst (cons (cdr (nth toto lst)) newlst))

Mais tel quel c'est déjà pas mal et plutôt très utile si on s'arrête là.

Là où j'ai voulu aider l'utilisateur c'est de donner la valeur du PK.
Le plan à contrôler est un plan schématique avec une échelle de Point Kilométrique (d'où PK). Pour information PKT = Point Kilométrique Terrain.
Visuellement c'est intéressant pour nous (utilisateurs AutoCAD) mais aussi pour les chargés d'affaires qui eux non pas accès à AutoCAD mais ont le plan sous format PDF.

A partir de là, j'ai voulu ajouter la valeur de l'attribut "PK" à la valeur de l'attribut "NUMCDV".
Plusieurs options : ("cdv 231A" "3.173A") ou ("cdv 231A" . "3.173A") ou ("cdv 231A au PK 3.173A")
Bien évidement la fonction sub ne fonctionne plus avec ce type d'argument et n'a pas été conçu pour ça de toutes façons.
Donc j'ai essayé de trouver une autre solution (ma fonction tri) qui consiste à récupérer la deuxième valeur de mes doublons, ici "cdv 231A" de (3 . "cdv 231A") provenant de la fonction sub2 et de la chercher dans la grande liste (valeur de l'attribut "NUMCDV" + valeur de l'attribut "PKT") afin d'afficher mes doublons avec mes PK de cette façon : ("cdv 231A au PK 3.173A" "cdv 231A au PK 3.514A" "cdv 231A au PK 5.122A").

Si ma fonction tri fonctionne plutôt bien en mode manuel en changeant la valeur de toto (setq toto 3) par exemple, ben dès que j'essaye de la mettre dans une boucle ça ne fonctionne plus.
Peut-être qu'il ne faut pas utiliser un while, un repeat peut-être ?
C'est là où je coince car je souhaite obtenir quelque chose comme : (("cdv 231A au PK 3.173A" "cdv 231A au PK 3.514A" "cdv 231A au PK 5.122A") ("cdv 251 au PK 4.173A" "cdv 251 au PK 3.673A") ("cdv 200B au PK 1.843" "cdv 200B au PK 3.053" "cdv 200B au PK 10.822"))

Pour sub2, j'ai pas pensé à vl-remove-if donc je te fais confiance.

Est-ce plus clair ?

[Edit] rectification de la cohérence dans la liste de résultat finale concernant les "cdv 200B"

Curlygoth · le 5 février 2022

une autre approche :

faire qu'une fonction que donne le nom en cas de suppression cela nomme l'objet de l'attribut qui est effacer (qui manque donc) ?

JPhil · le 5 février 2022

Peux-tu développer ton approche ?

(gile) · le 5 février 2022

Salut,

Si j'ai bien compris, tu pourrais traiter le jeu de sélection pour grouper les références de bloc par valeur de l'attribut NUMCDV dans une liste d'association dont le 'car' serait la valeur de l'attribut et le 'cdr' la liste des blocs avec cette valeur d'attribut.

;; grouper les références de bloc du jeu de sélection par valeur d'attribut "NUMCDV")
(setq blocsParCdv nil)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "JOINT_VOIE*"))))
  (repeat (setq i (sslength ss))
    (setq bloc	      (ssname ss (setq i (1- i)))
	  cdv	      (getpropertyvalue bloc "NUMCDV")
	  blocsParCdv (if (setq entry (assoc cdv blocsParCdv))
			(subst (cons cdv (cons bloc (cdr entry))) entry blocsParCdv)
			(cons (cons cdv (list bloc)) blocsParCdv)
		      )
    )
  )
)

Cette liste peut ensuite être manipulée avec les nombreuse fonctions de traitement des liste que fournit AutoLISP.

Filtrer les doublons :

(setq doublons (vl-remove-if '(lambda (x) (< 1 (length (cdr x))))) blocsParCdv)

Compter les doublons par valeur d'attribut :

(mapcar '(lambda (x) (cons (car x) (length (cdr x)))) doublons)

Lister les doublons par PK :

(apply
  'append
  (mapcar '(lambda (x)
	     (mapcar '(lambda (y)
			(strcat "cdv " (car x) " au PK " (getpropertyvalue y "PKT"))
		      )
		     (cdr x)
	     )
	     doublons
	   )
  )
)

Sélection tous les blocs ayant des doublons :

(setq ssDoublons (ssadd))
(foreach x (apply 'append (mapcar 'cdr doublons))
  (ssadd x ssDoublons)
)
(sssetfirst nil ssDoublons)

etc.

JPhil · le 5 février 2022

Je testerai prochainement ton code.

Si je vois l'idée j'ai besoin de voir le résultat à chaque étape pour bien comprendre.

Merci ;)

Luna · le 5 février 2022

@JPhil,

En effet c'est déjà un peu plus clair pour moi. Et du coup je rejoins l'idée de @(gile) qui consiste à créer une liste d'association dont ta clé de recherche est la valeur de ton attribut CDV et la valeur associée correspond à la liste des blocs concernés. C'est plus direct et nettement plus simple en terme de manipulation car cela s'applique pour de nombreux programmes.

Bisous,
Luna

Curlygoth · le 7 février 2022

Citation

faire qu'une fonction que donne le nom en cas de suppression cela nomme l'objet de l'attribut qui est effacer (qui manque donc) ?

Et bien tu as tes blocs avec des attributs qui ont des valeurs

personnellement j'assigne une valeur à l'attribut à mes blocs à l'insertion,

je vérifie si dans un attribut avec une valeur : PREFIXE - NUM - SUFFIXE je verifie tous les "NUM"

(Je nomme en 1,2,3,4... ou A,B,...Z,AA,AB...)

Et si à l'insertion il manque le 3 ou le D (car je l'ai surement supprimer), le blocs prendra la valeur manquante, et s'il ne manque rien il prends la valeur suivante.

JPhil · le 7 février 2022

@Curlygoth,

Les numéros de CDV ne se suivent pas forcément , il peut y avoir des trous.
Le plan est déjà existant, il s'agit d'une vérification afin de voir s'il n'y a pas de doublons, et si doublons alerter toutes les équipes afin de "réparer" au mieux.

Je viens de tester le code de @(gile) :

(defun c:TestControle ()
;; grouper les références de bloc du jeu de sélection par valeur d'attribut "NUMCDV")
(setq blocsParCdv nil)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "JOINT_VOIE*"))))
  (repeat (setq i (sslength ss))
    (setq bloc          (ssname ss (setq i (1- i)))
      cdv          (getpropertyvalue bloc "NUMCDV")
      blocsParCdv (if (setq entry (assoc cdv blocsParCdv))
            (subst (cons cdv (cons bloc (cdr entry))) entry blocsParCdv)
            (cons (cons cdv (list bloc)) blocsParCdv)
              )
    )
  )
)

(setq doublons (vl-remove-if '(lambda (x) (< 1 (length (cdr x)))) blocsParCdv))

;;; donne le résultat suivant :
;;; ((cdv 593D <Nom d'entité: 25786140b30>) (cdv 593C <Nom d'entité: 25786140ad0>) (cdv 593B <Nom d'entité: 25786140a80>) (cdv 593A <Nom d'entité: 2578613dd50>) (cdv 468B <Nom d'entité: 257863cdad0>) ("cdv 468B" <Nom d'entité: 257863cdad0>)...)
;;; il manque les deux "cdv 468A" ainsi que les deux "cdv 505"

(mapcar '(lambda (x) (cons (car x) (length (cdr x)))) doublons)

;;; donne le résultat suivant :
;;; (("cdv 593D" . 1) ("cdv 593C" . 1) ("cdv 593B" . 1) ("cdv 593A" . 1) ("cdv 468B" . 1) ...)

(apply
  'append
  (mapcar '(lambda (x)
         (mapcar '(lambda (y)
            (strcat (car x) " au PK " (getpropertyvalue y "PKT"))
              )
             (cdr x)
         )
       )
         doublons
  )
)

;;; donne le résultat suivant :
;;; ("cdv 593D au PK 0.700VE" "cdv 593C au PK 0.591VE" "cdv 593B au PK 0.511VE" "cdv 593A au PK 0.432VE" "cdv 468B au PK 5.910" ...)


) ; fin defun

Je pense qu'il y a un problème car pour le "cdv 468A" j'en ai deux ("cdv 468A au PK 5.951" et "cdv 468A au PK 6.846") tout comme le "cdv 505" ("cdv 505 au PK 7.060" et "cdv 505 au PK 7.343"), mais ils n'apparaissent pas dans la liste.
"Doublons" me donne 448 éléments or il y'en a 469 (length txtCDVPK) dans mon programme d'essai.
Une idée du pourquoi du comment ?

Luna · le 7 février 2022

@JPhil,

Je crois que l'erreur vient juste de là :

(setq doublons (vl-remove-if '(lambda (x) (< 1 (length (cdr x)))) blocsParCdv))

Si je suis logique, cela signifie que tu supprimes (vl-remove) la paire d'association (x) si (-if) le nombre d'entités (length (cdr x)) est strictement supérieur (<) à 1. Autrement dit, tu obtiens l'inverse de ta liste de doublons... xD donc fait plutôt :

(setq doublons (vl-remove-if '(lambda (x) (= 1 (length (cdr x)))) blocsParCdv))

Et cela devrait donner le résultat souhaité (i hope...) car tu veux traiter les doublons plutôt que les références uniques je présume 😉

Bisous,
Luna

JPhil · le 7 février 2022

Bien vu Luna,

On est presque au bout car il affiche même les cdv vides :

Citation

("cdv 858B au PK 15.831" "cdv 858B au PK 15.865" "cdv 831B au PK 14.509" "cdv 831B au PK 14.591" "cdv 622 au PK 0.139C" "cdv 622 au PK 13.320" "cdv 557 au PK 0.037" "cdv 557 au PK 10.482" "cdv 517 au PK 7.932" "cdv 517 au PK 7.932" "cdv 505 au PK 7.343" "cdv 505 au PK 7.060" "cdv 482 au PK 7.007" "cdv 482 au PK 6.674" "cdv 480 au PK 6.943" "cdv 480 au PK 6.511" "cdv 468A au PK 6.846" "cdv 468A au PK 5.951" "cdv 466 au PK 6.035" "cdv 466 au PK 5.846" "cdv 461B au PK 5.730" "cdv 461B au PK 5.615" " au PK 0.200VE" " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK 0.374" " au PK " " au PK " " au PK " " au PK " " au PK 2.655A" " au PK 0.333" " au PK 0.546VA" " au PK 0.631VB" " au PK 0.038V3" " au PK " " au PK " " au PK " " au PK " " au PK " " au PK 3.900" " au PK " " au PK " " au PK " " au PK " " au PK " " au PK " " au PK 14.570" " au PK 14.406" " au PK 14.406" " au PK 14.416" " au PK 14.312" " au PK 0.354VR" " au PK 7.792" " au PK 3.253A" " au PK 3.253A")

Le résultat de la commande :

(mapcar '(lambda (x) (cons (car x) (length (cdr x)))) doublons)

est :

Citation

(("cdv 858B" . 2) ("cdv 831B" . 2) ("cdv 622" . 2) ("cdv 557" . 2) ("cdv 517" . 2) ("cdv 505" . 2) ("cdv 482" . 2) ("cdv 480" . 2) ("cdv 468A" . 2) ("cdv 466" . 2) ("cdv 461B" . 2) ("" . 47))

Un coup de baguette magique pour enlever les vides et voici le lisp final :

(defun c:TestControleRFL10 ()
;; grouper les références de bloc du jeu de sélection par valeur d'attribut "NUMCDV")
(setq blocsParCdv nil)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "JOINT_VOIE*"))))
  (repeat (setq i (sslength ss))
    (setq bloc          (ssname ss (setq i (1- i)))
      cdv          (getpropertyvalue bloc "NUMCDV")

      blocsParCdv (if (setq entry (assoc cdv blocsParCdv))
            (subst (cons cdv (cons bloc (cdr entry))) entry blocsParCdv)
            (cons (cons cdv (list bloc)) blocsParCdv)
              )
    )
  )
)

(setq doublons (vl-remove-if '(lambda (x) (= 1 (length (cdr x)))) blocsParCdv))

(mapcar '(lambda (x) (cons (car x) (length (cdr x)))) doublons)

(vl-remove-if '(lambda (x) (= x nil)) 
(apply
  'append
  (mapcar '(lambda (x)
         (mapcar '(lambda (y)
            (if (/= (car x) "") (strcat (car x) " au PK " (getpropertyvalue y "PKT")))
              )
             (cdr x)
         )
       )
         doublons
  )
)
) ; fin vl-remove-if

) ; fin defun

Le résultat final :

Citation

("cdv 858B au PK 15.831" "cdv 858B au PK 15.865" "cdv 831B au PK 14.509" "cdv 831B au PK 14.591" "cdv 622 au PK 0.139C" "cdv 622 au PK 13.320" "cdv 557 au PK 0.037" "cdv 557 au PK 10.482" "cdv 517 au PK 7.932" "cdv 517 au PK 7.932" "cdv 505 au PK 7.343" "cdv 505 au PK 7.060" "cdv 482 au PK 7.007" "cdv 482 au PK 6.674" "cdv 480 au PK 6.943" "cdv 480 au PK 6.511" "cdv 468A au PK 6.846" "cdv 468A au PK 5.951" "cdv 466 au PK 6.035" "cdv 466 au PK 5.846" "cdv 461B au PK 5.730" "cdv 461B au PK 5.615")

Merci @(gile) et @Luna 🙂

JPhil · le 10 février 2022

Suite à différents essais, il faut changer

(if (/= (car x) "") (strcat (car x) " au PK " (getpropertyvalue y "PKT")))

par

(if (= (strcase (substr (car x) 1 3)) "CDV") (strcat (car x) " au PK " (getpropertyvalue y "PKT")))

Afin de conserver uniquement les blocs dont la valeur de l'attribut "NUMCDV" commence par "cdv ..."

Luna · le 10 février 2022

Tu peux également utiliser la fonction (wcmatch) au lieu de

(= (strcase (substr (car x) 1 3)) "CDV")

tu peux également l'écrire

(wcmatch (strcase (car x)) "CDV*")

Bisous,
Luna

JPhil · le 10 février 2022

En plus c'est pas comme si je ne la connaissais pas celle-là xD

Test contrôle d'attribut de bloc en doublon

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante