Aller au contenu

Concaténer valeur de attribut suivant une sélection manual


yann69690

Messages recommandés

Bonjour,

Je souhaiterai adapter un code (dont malheureusement je ne comprends pas cela dépasse mes capacités).

L'idée est de récupérer des blocs (toujours le même nom) via une sélection manuel (avant de lancer le Lisp ou qu'il demande de sélectionner des objets) dont je souhaiterai concaténer la valeur de ces attributs (IDENT) dans un autre bloc (étiquette) en mettant à jour l'attribut NUM_CANDELABRE. A savoir, j'ai créer deux étiquettes dont 1 avec une ligne et l'autre deux lignes car en le faisant à la main cela m'évite un clic 🤣.

Si quelqu'un à la solution dans le bloc du candélabre, j'ai créé un champ dynamique rotation mais je n'arrive pas à mettre à jour (redéfinir) mes anciens blocs (si insérer, les nouveaux sont dynamique mais pas les anciens)

image.png.2c76da21fae773bf953fdd50ff6e6fa5.png

Script que je trouve proche de @Luna (merci d'ailleurs il va me servir le script original pour faire des synoptiques):

(defun c:SumAtt (/ foo checkblock set-att-list subreal PreIntSuf param bname jsel i name vnam att lst ent)
  (defun foo (x f)
    (if f
      (if (listp x)
        (mapcar f x)
        ((eval f) x)
      )
      x
    )
  )
  (defun checkblock ( ent blk lst fun / vla att )
    (and
      (setq vla (vlax-ename->vla-object ent))
      (vlax-property-available-p vla 'EffectiveName)
      (wcmatch (foo (vla-get-EffectiveName vla) fun) (foo blk fun))
      (setq att (mapcar '(lambda (a) (cons (vla-get-tagstring a) (vla-get-textstring a))) (vlax-invoke vla 'getAttributes)))
      (setq att (vl-remove-if-not '(lambda (a) (member (foo (car a) fun) (foo lst fun))) att))
    )
    att
  )
  (defun set-att-list (blk lst / itm tmp)
    (foreach att (vlax-invoke blk 'getAttributes)
      (if (setq itm (assoc (vla-get-tagstring att) lst))
        (progn (vla-put-textstring att (cdr itm)) (setq tmp (cons itm tmp)))
      )
    )
    tmp
  )
  (defun subreal (str num)
    (setq str (PreIntSuf str))
    (apply 'strcat (subst num (cadr str) str))
  )
  (defun PreIntSuf (str / l x n p i s)
    (repeat (length (setq l (vl-string->list str)))
      (setq x (car l))
      (cond
        ( (and p s) (setq s (cons x s)))
        ( (and
            (distof (chr x))
            n
            (= "-" (chr n))
          )
          (setq
            i (append (list n) i)
            i (cons x i)
          )
        )
        ( (or
            (distof (chr x))
            (and
              (= "." (chr x))
              n
              (distof (chr n))
            )
          )
          (setq i (cons x i))
        )
        ( (null i) (setq p (cons x p)))
        ( i (setq s (cons x s)))
      )
      (setq
        l (cdr l)
        n x
      )
    )
    (mapcar '(lambda (l) (set (read (vl-symbol-name l)) (reverse (vl-symbol-value l)))) (list 'p 'i 's))
    (if
      (and
        i (= "-" (chr (car i)))
        p (= "-" (chr (last p)))
      )
      (setq p (reverse (cdr (reverse p))))
    )
    (list
      (vl-list->string p)
      (vl-list->string i)
      (vl-list->string s)
    )
  )
  
  (setq
    param (list "PUISSANCE" "DEBIT" "PUISS_CH" "PUISS_FR" "DEB_CH" "DEB_FR") ; Liste des noms d'attribut
    bname "*" ; Liste des noms de blocs (séparer les noms par des virgules, sans espaces !)
  )
  (if (setq jsel (ssget (list '(0 . "INSERT") '(66 . 1) (cons 2 bname))))
    (progn
      (repeat (setq i (sslength jsel))
        (and
          (setq name (ssname jsel (setq i (1- i))))
          (setq att (checkblock name bname param 'strcase))
          (mapcar
            '(lambda (a / s v)
              (setq s (strcase (car a)))
              (setq v (cond ((distof (cdr a))) (0.0)))
              (setq lst
                (if (assoc s lst)
                  (subst
                    (cons s (+ (cdr (assoc s lst)) v))
                    (assoc s lst)
                    lst
                  )
                  (append lst (list (cons s v)))
                )
              )
            )
            att
          )
        )
      )
      (princ "\nVeuillez sélectionner un bloc étiquette...")
      (if (setq jsel (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
        (progn
          (and
            (setq name (ssname jsel 0))
            (setq att (checkblock name bname param 'strcase))
            (set-att-list
              (vlax-ename->vla-object name)
              (vl-remove
                nil
                (mapcar
                  '(lambda (a)
                    (if (setq b (assoc (car a) lst))
                      (progn
                        (setq str (cdr a))
                        (if (distof str)
                          (cons (car a) (rtos (cdr b) 2 2))
                          (cons (car a) (subreal (cdr a) (rtos (cdr b) 2 2)))
                        )
                      )
                    )
                  )
                  att
                )
              )
            )
          )
        )
        (entmakex
          (list
            '(0 . "MTEXT")
            '(100 . "AcDbEntity")
            '(100 . "AcDbMText")
            (cons 10 (getpoint "\nVeuillez spécifier un point d'insertion (MText) : "))
            (cons 1 (apply 'strcat (mapcar '(lambda (x) (strcat (car x) " = " (rtos (cdr x) 2 2) "\\P")) lst)))
          )
        )
      )
    )
  )
  (princ)
)

Fichier exemple

Etiquette.dwg

Je vous remercie par avance ça me sauverais pas mal de clic et recopie inutile

Cordialement

Lien vers le commentaire
Partager sur d’autres sites

Salut, 

Justement c'est le but de supprimer aussi un attribut pour faire le ménage (c'est pas de moi qui est mis deux fois IDENT, j'ai récupérer le fichiers comme ça et j'essaie de traiter avec).

J'ai recréée 2 attributs IDENT en editant le bloc + attsync mais rien n'y fait, j'ai pas idée comment résoudre ça
J'ai tester recréer un bloc avec un autre nom et blockreplace mais quand on remplace ça ne fonctionne pas

cordialement

Lien vers le commentaire
Partager sur d’autres sites

il y a 7 minutes, lecrabe a dit :

Hello

MAIS @Luna n'a pas realise un Lisp special pour ce probleme !?

Bye, lecrabe

 

Non il me semble pas, Luna avait un script qu'elle m'a transmis pour supprimer ceux dont il n'a pas de référence d'attribut dans les blocs suite à un bug (ou pour moi je pense un mauvais export d'un SIG), mais j'avais besoin des infos dedans, donc ma solution a été de recréer les attribut dont j'avais besoin. Mais on est d'accord c'est le même fichier où je me prends la tête.
https://cadxp.com/topic/57732-bloc-attribut-disparu/

 

Lien vers le commentaire
Partager sur d’autres sites

Je n'ai en effet pas de programmes sous la main capable de supprimer les attributs en doublons d'une définition de bloc et encore moins de réimplanter des attributs manquants dans la définition de bloc mais apparaissant dans les propriétés d'une référence de bloc ^^"

J'ai pas les compétences pour ces tours de magie (même si théoriquement la première semble faisable), désolée >w<

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

il y a 1 minute, Luna a dit :

Je n'ai en effet pas de programmes sous la main capable de supprimer les attributs en doublons d'une définition de bloc et encore moins de réimplanter des attributs manquants dans la définition de bloc mais apparaissant dans les propriétés d'une référence de bloc ^^"

J'ai pas les compétences pour ces tours de magie (même si théoriquement la première semble faisable), désolée >w<

Bisous,
Luna

Bonjour Luna,

Heureusement tu m'as donner l'astuce, il suffit de les recréer dans le bloc et après je trouve le plus simple et de créer un autre bloc et de tout remplacer via pTmanager du grand Lee mac, comme cela on repart sur de bonne base (au milieu on modifie le fichier via excel pour garder l'attribut que l'on veut).

Mai si tu es une magicienne, la preuve je décrypte toujours ton script du dessus, ( pour voir quoi enlever mais il est tres complexe pour ce que je veux faire qui est juste concaténé une sélection de bloc).

Merci à vous 

Cordialement

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

1->Sur ce fichier pas mal donc 550 blocs.
2->Habituellement, je ne traite pas ces documents comme ça, je refais à la main (insert un nouveau bloc (sans attribut) au même emplacement), donc je me suis jamais confronté à ce problème (de vouloir garder les infos et qu'elle soit en double). Mais je viens de vérifier j'ai le cas sur l'ensemble des fichiers (et plusieurs variable en doublons en plus).

Mon but était de travailler sur ce gros dossier de 450 points lumineux et m'en servir après pour le reste de mes dossiers pour automatiser un mon travail.

A quoi vous pensez? 

cdlt

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Lecrabe, 

C'est une bonne idée, sachant qu'à l'origine c'est bien un DXF que je reçois et après exploite en PDF, je viens d'en ouvrir un (la plus petite commune, c'est quand meme 22mo ci-joint sur le lien we-transfert (ce n'est pas celui de 500bloc mais 168 bloc mat "7_7214", c'est deux rond)).

https://we.tl/t-SL7zwIkGmd

Quasiment touts les blocs (en 7_**) ont des attributs en double mais c'est bien à chaque fois le même nom de bloc.

Merci et je vous souhaite une bonne journée

Yann

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,
 

Pour revenir, sur mon premier post, ci-joint un Lisp pas mal utilie qui copie les attribut concaténné, et il reste plus qu'à coller dans le bon block/attribut.

Lisp de  BeekeeCZ que je remercie ( lien )

 

(defun c:CollectAtts ( / s i v l h x)

  (or (and *ca-a* (/= *ca-a* "")) (setq *ca-a* "IDENT"))          ;Adopterl'attribut IDENT
  
  (if (and (not (initget 128))
	   (setq *ca-a* (cond ((getkword (strcat "\nAttribute <" *ca-a* ">: "))) (*ca-a*)))
	   (setq s (ssget '((0 . "INSERT") (66 . 1))))
	   )
    (repeat (setq i (sslength s))
      (if (not (vl-catch-all-error-p (setq v (vl-catch-all-apply 'getpropertyvalue (list (ssname s (setq i (1- i))) *ca-a*)))))
	(setq l (cons v l)))))
  (if l
    (progn
      (setq
	;l (vl-sort l '<)                       ; remove the initial semicolon to activate sort
	x (substr (apply 'strcat (mapcar '(lambda (x) (strcat "-" x)) l)) 2))
      (vlax-invoke (vlax-get (vlax-get (setq h (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" x)
      (vlax-release-object h)
      (princ (strcat "\nClipboard: " x))))
  (princ)
  )

 

Cordialement

Lien vers le commentaire
Partager sur d’autres sites

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
×
  • 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é