Aller au contenu

Luna

Membres
  • Compteur de contenus

    1 113
  • Inscription

  • Dernière visite

  • Jours gagnés

    42

Tout ce qui a été posté par Luna

  1. Coucou, Une autre solution serait de sélectionner le champ et de faire un clic droit > Convertir le champ en texte. Cependant si le but est de modifier un ensemble de références de bloc, cela peut prendre un peu de temps car il te faut utiliser la commande ATTEDIT donc un par un. Comme le suggère @lili2006, la commande BURST pourrait correspondre à ton besoin (seulement si tu acceptes de décomposer tes références de blocs), mais si tu veux uniquement convertir la valeur du champ dynamique sous forme de texte en conservant ton bloc alors il faudrait trouver autre chose. Petite question : Si tu dois conserver ta référence de bloc intacte, quel est l'intérêt de convertir ton champ dynamique sous forme de texte exactement ? Est-ce parce que les valeurs du champs ne correspondent pas aux valeurs devant être affichées ? Bisous, Luna
  2. Coucou, Peut-être voir de ce côté-là pour commencer ? https://www.autodesk.fr/support/technical/article/caas/sfdcarticles/sfdcarticles/FRA/Layer-Properties-Manager-does-not-display-in-AutoCAD.html Mais étrange si cela est pareil pour l'ensemble des postes... Bisous, Luna
  3. Luna

    synoptique

    Coucou @PHIL-lang, Cela ne me semble pas du tout fonctionnel. Ce que @(gile) demandait ici c'est que tu expliques ce que tu désires réaliser et fournisse un .dwg d'exemple avec les blocs à considérer pour le programme et un exemple avant/après pour bien comprendre les démarches à suivre. Cela va nous permettre ensuite de traduire ta demande d'un point de vue algorithmique pour développer un programme répondant directement à ton besoin. Par exemple, qu'entends-tu par ? En clair, que signifie le terme "classe" dans ta phrase ci-dessus ? Cela correspond probablement à un déplacement ou bien une copie des blocs à un endroit particulier ? Est-ce sous forme de tableau ? De liste (Horizontale ou Verticale ?) ? Bref, je suppose que tu t'appuies sur ChatGPT ou du moins une IA pour te proposer des programmes et cela n'est malheureusement pas la démarche à suivre (du moins pour le LISP, car c'est un langage trop peu utilisé pour permettre à l'IA d'être pertinente sur ses propositions). Je te suggère donc de nous donner l'ensemble des données/informations/contraintes relatives à ton besoin afin que l'on puisse t'aider au mieux en te proposant des programmes répondant à ton besoin. Plus tu fourniras de détails dans les instructions à suivre, plus il sera facile et rapide pour nous de cibler ton besoin et d'y répondre efficacement par le biais de programmes déjà existants ou bien en développant un nouveau programme. En espérant que se soit suffisamment clair pour toi 🙂 Bisous, Luna
  4. Luna

    Concaténer 2 textes cote à cote

    Coucou, Désolée pour le délai, je n'ai pas pu trouver de temps libre plus tôt. J'ai testé sur ton DWG et cela semble être bon : (defun c:JVC_ASSOTXT (/ *error* foo e fuzz layer cmdecho jsel i name lst tmp err) ;; PARAMETRAGE UTILISATEUR !!! (setq layer "TOU_EU_ALTI_FE" ;; --> Calque défini pour le filtre de sélection (si plusieurs, séparer par une virgule sans espace!) e 0.952993 ;; --> Distance à prendre en compte entre les 2 textes à associer fuzz 1E-4 ;; --> Précision sur l'écart entre la distance à considérer pour associer les textes et la distance réelle entre 2 textes ) ;; FIN DU PARAMETRAGE UTILISATEUR !!! (defun *error* (msg) (setvar "CMDECHO" cmdecho) (princ msg) ) (defun foo (lst / name pt tmp ent) (if (and (setq name (car lst) pt (cdr (assoc 10 (entget name))) tmp (cdr lst) ) (not (while (not (equal (distance pt (cdr (assoc 10 (entget (car tmp))))) e fuzz)) (setq tmp (cdr tmp)) ) ) (setq ent (car tmp)) ) (progn (setq lst (cdr lst)) (setq lst (vl-remove ent lst)) (setq tmp (ssadd name)) (ssadd ent tmp) (command "TXT2MTXT" tmp "") (setq name (entlast)) (entmod (subst '(41 . 3) (assoc 41 (entget name)) (entget name))) lst ) name ) ) (sssetfirst) (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object))) (and (setq cmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq err (ssadd)) (setq jsel (ssget "_X" (list '(0 . "TEXT") (cons 8 layer)))) (repeat (setq i (sslength jsel)) (setq name (ssname jsel (setq i (1- i))) lst (cons name lst) ) ) (not (while lst (if (not (listp (setq tmp (foo lst)))) (progn (ssadd tmp err) (setq lst (cdr lst)) ) (setq lst tmp) ) ) ) (sssetfirst nil err) (setvar "CMDECHO" cmdecho) (princ (strcat "\nUn total de " (itoa (sslength jsel)) " blocs ont été traités." (if (< 0 (sslength err)) (strcat "\n /!\\ " (itoa (sslength err)) "/" (itoa (sslength jsel)) " blocs ont échoués dans le traitement...") "" ) ) ) ) (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) Je n'ai pas émis l'hypothèse que tu puisses changer les paramètres au cours de la commande mais je les ai tout de même regroupé en début de programme pour modifier les calques (pour filtrer la sélection), la distance à considérer et la tolérance. En espérant que c'est OK pour toi 🙂 Bisous, Luna
  5. Luna

    Concaténer 2 textes cote à cote

    J'ai une idée éventuelle mais il me faudrait un .dwg d'exemple pour voir si c'est faisable. Et ce n'est pas optimale car chat reviendrait à tester si la distance entre un premier texte et les autres est inférieure (voire égale) à une valeur spécifique et lancer la commande sur ces deux textes, puis passer au texte suivant, etc... Bisous, Luna
  6. Dans ce cas au lieu de renvoyer l'information 'found' à la fin de la fonction, renvoie plutôt l'information 'layer'. Cependant pour éviter tout problème, il faut renvoyer l'info SI found existe ! Donc remplace found par (if found layer) Bisous, Luna
  7. Haha, pas de soucis 🙂 chat arrive à tout le monde ^^ Bisous, Luna
  8. Coucou, Essaye ceci : (layerExists "*_00*Plan*Pièce*Jour*") Tu as je pense juste oublier d'ajouter un astérisque "*" après "Jour" 🙂 Bisous, Luna
  9. Luna

    Concaténer 2 textes cote à cote

    Coucou, Pourquoi ne pas lancer la commande TXT2MTXT à plusieurs reprise en ne sélectionnant que 2 textes à chaque fois ? De combien de concaténation parle-t-on ? Car autrement, comment souhaites-tu faire comprendre à AutoCAD quels textes doivent être merge ensemble ou non si tu sélectionnes tous tes textes en une seule fois ? Bisous, Luna
  10. Oki doki, dis-moi si c'est good pour toi :3 (defun c:ChangeLayerBlockOnVertex (/ str2lst lst2str ListBox vla-collection->list nam_blk jsel ss_blk ss_poly i ent_poly nam_lay lst_pt n ent_blk dxf_blk pt name) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun lst2str (lst sep) (if lst (vl-string-left-trim sep (apply 'strcat (mapcar '(lambda (x) (strcat sep (vl-princ-to-string x))) lst) ) ) ) ) (defun ListBox (title msg lst value flag h / vl-list-search LB-select tmp file DCL_ID choice tlst) (defun vl-list-search (p l) (vl-remove-if-not '(lambda (x) (wcmatch x p)) l) ) (defun LB-select (str) (if (= "" str) "0 selected" (strcat (itoa (length (str2lst str " "))) " selected") ) ) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") tlst lst ) (write-line (strcat "ListBox:dialog{width=" (itoa (+ (apply 'max (mapcar 'strlen (mapcar 'vl-princ-to-string lst))) 5)) ";label=\"" title "\";") file ) (write-line ":edit_box{key=\"filter\";}" file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ( (= 0 flag) "spacer;:popup_list{key=\"lst\";}") ( (= 1 flag) (strcat "spacer;:list_box{height=" (itoa (1+ (cond (h) (15)))) ";key=\"lst\";}")) ( T (strcat "spacer;:list_box{height=" (itoa (1+ (cond (h) (15)))) ";key=\"lst\";multiple_select=true;}:text{key=\"select\";}")) ) file ) (write-line ":text{key=\"count\";}" file) (write-line "spacer;ok_cancel;}" file) (close file) (setq DCL_ID (load_dialog tmp)) (if (not (new_dialog "ListBox" DCL_ID)) (exit) ) (set_tile "filter" "*") (set_tile "count" (strcat (itoa (length lst)) " / " (itoa (length lst)))) (start_list "lst") (mapcar 'add_list lst) (end_list) (set_tile "lst" (cond ( (and (= flag 2) (listp value) ) (apply 'strcat (vl-remove nil (mapcar '(lambda (x) (if (member x lst) (strcat (itoa (vl-position x lst)) " "))) value))) ) ( (member value lst) (itoa (vl-position value lst))) ( (itoa 0)) ) ) (if (= flag 2) (progn (set_tile "select" (LB-select (get_tile "lst"))) (action_tile "lst" "(set_tile \"select\" (LB-select $value))") ) ) (action_tile "filter" "(start_list \"lst\") (mapcar 'add_list (setq tlst (vl-list-search $value lst))) (end_list) (set_tile \"count\" (strcat (itoa (length tlst)) \" / \" (itoa (length lst))))" ) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) tlst) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) tlst)) ) ) (done_dialog)" ) (start_dialog) (unload_dialog DCL_ID) (vl-file-delete tmp) choice ) (defun vla-collection->list (doc col flag / lst item i) (if (null (vl-catch-all-error-p (setq i 0 col (vl-catch-all-apply 'vlax-get (list (cond (doc) ((vla-get-activedocument (vlax-get-acad-object)))) col)) ) ) ) (vlax-for item col (setq lst (cons (cons (if (vlax-property-available-p item 'Name) (vla-get-name item) (strcat "Unnamed_" (itoa (setq i (1+ i)))) ) (cond ( (= flag 0) (vlax-vla-object->ename item)) (item) ) ) lst ) ) ) ) (reverse lst) ) (and (setq nam_blk (list "DETECT")) ;; <-- Entrer le(s) nom(s) des blocs pour le filtre de sélection (setq nam_blk (ListBox "Sélection du/des bloc(s)" "Veuillez sélectionner un ou plusieurs bloc(s) :" (vl-sort (vl-remove-if '(lambda (x) (wcmatch x "`**")) (mapcar 'car (vla-collection->list nil 'blocks 1))) '<) nam_blk 2 nil ) ) (setq jsel (ssadd)) (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat (lst2str nam_blk ",") ",`*U*"))))) (setq ss_poly (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss_poly)) (setq ent_poly (ssname ss_poly (setq i (1- i))) nam_lay (assoc 8 (entget ent_poly)) lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent_poly))) ) (repeat (setq n (sslength ss_blk)) (setq ent_blk (ssname ss_blk (setq n (1- n))) dxf_blk (entget ent_blk) pt (cdr (assoc 10 dxf_blk)) name (vla-get-EffectiveName (vlax-ename->vla-object ent_blk)) ) (mapcar '(lambda (x) (if (and (member name nam_blk) (equal (list (car pt) (cadr pt)) (list (car x) (cadr x)) 1E-08) ) (progn (entmod (subst nam_lay (assoc 8 dxf_blk) dxf_blk)) (ssadd ent_blk jsel) ) ) ) lst_pt ) T ) ) (null (sssetfirst)) (princ (strcat "\nUn total de " (itoa (sslength jsel)) "/" (itoa (sslength ss_blk)) " bloc(s) nommé(s) \"" (lst2str nam_blk ", ") "\" ont été modifié(s)")) (sssetfirst nil jsel) ) (princ) ) Bisous, Luna
  11. Coucou, Je te propose la version modifiée pour regrouper le nom du bloc sous forme de variable donc comme chat il suffit de le modifier une seule fois au début. Si jamais, je peux également ajouter une question pour rentrer le nom du bloc ou bien je peux aussi ouvrir une boîte de dialogue pour sélectionner les blocs dans une liste. ;; * Il est possible de spécifier plusieurs noms de blocs (utiliser une virgule ","), de faire des recherches relatives (cf. Wildcard Characters), etc... ;; /!\ Ne modifier que le texte situé entre les guillemets ! ;; Exemple : ;; - "DETECT,TCPOINT" -> Le nom du bloc peut être "DETECT" ou bien "TCPOINT" ;; - "*Point*" -> Le nom du bloc doit contenir la chaîne de caractères "POINT" peut importe sa position (donc "TCPOINT" est sélectionné) ;; /!\ La casse n'a pas d'importance, les noms seront comparés avec la même casse (MAJUSCULE). (defun c:ChangeLayerBlockOnVertex (/ str2lst nam_blk jsel ss_blk ss_poly i ent_poly nam_lay lst_pt n ent_blk dxf_blk pt name) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (and (setq nam_blk (strcase "DETECT")) ;; <-- Entrer le(s) nom(s) des blocs* pour le filtre de sélection (setq jsel (ssadd)) (setq ss_blk (ssget "_X" (list '(0 . "INSERT") (cons 2 (strcat nam_blk ",`*U*"))))) (setq ss_poly (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss_poly)) (setq ent_poly (ssname ss_poly (setq i (1- i))) nam_lay (assoc 8 (entget ent_poly)) lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent_poly))) ) (repeat (setq n (sslength ss_blk)) (setq ent_blk (ssname ss_blk (setq n (1- n))) dxf_blk (entget ent_blk) pt (cdr (assoc 10 dxf_blk)) name (strcase (vla-get-EffectiveName (vlax-ename->vla-object ent_blk))) ) (mapcar '(lambda (x) (if (and (member T (mapcar '(lambda (x) (wcmatch x name)) (str2lst nam_blk ","))) (equal (list (car pt) (cadr pt)) (list (car x) (cadr x)) 1E-08) ) (progn (entmod (subst nam_lay (assoc 8 dxf_blk) dxf_blk)) (ssadd ent_blk jsel) ) ) ) lst_pt ) T ) ) (null (sssetfirst)) (princ (strcat "\nUn total de " (itoa (sslength jsel)) "/" (itoa (sslength ss_blk)) " bloc(s) \"" nam_blk "\" ont été modifiés")) (sssetfirst nil jsel) ) (princ) ) Si tu as des questions, n'hésites pas 🙂 Bisous, Luna
  12. Coucou, Oki, dans ce cas chat change tout ^^ Cela te convient-il mieux ? (defun c:ChangeLayerBlockOnVertex (/ jsel ss_blk ss_poly i ent_poly nam_lay lst_pt n ent_blk dxf_blk pt) (and (setq jsel (ssadd)) (setq ss_blk (ssget "_X" '((0 . "INSERT") (2 . "DETECT,`*U*")))) (setq ss_poly (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss_poly)) (setq ent_poly (ssname ss_poly (setq i (1- i))) nam_lay (assoc 8 (entget ent_poly)) lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent_poly))) ) (repeat (setq n (sslength ss_blk)) (setq ent_blk (ssname ss_blk (setq n (1- n))) dxf_blk (entget ent_blk) pt (cdr (assoc 10 dxf_blk)) ) (mapcar '(lambda (x) (if (and (= "DETECT" (vla-get-EffectiveName (vlax-ename->vla-object ent_blk))) (equal (list (car pt) (cadr pt)) (list (car x) (cadr x)) 1E-08) ) (progn (entmod (subst nam_lay (assoc 8 dxf_blk) dxf_blk)) (ssadd ent_blk jsel) ) ) ) lst_pt ) T ) ) (null (sssetfirst)) (princ (strcat "\nUn total de " (itoa (sslength jsel)) "/" (itoa (sslength ss_blk)) " bloc(s) \"DETECT\" ont été modifiés")) (sssetfirst nil jsel) ) (princ) ) Bisous, Luna
  13. Coucou, Est-ce que quelque chose comme chat fonctionne pour toi ? C'est un peu bancal mais bon, chat fonctionne dans l'ensemble. (defun c:LINSELB (/ get-pt-list blc mode jsel i name pt-lst tmp n obj) (defun get-pt-list (name / rp f o s e i l) (defun rp (p f) (mapcar '(lambda (c) (if (equal c 0.0 f) 0.0 c)) p) ) (and name (setq f 1e-15) (setq o (cdr (assoc 0 (entget name)))) (member o '("LWPOLYLINE" "POLYLINE" "LINE" "SPLINE" "ARC" "CIRCLE" "ELLIPSE")) (setq s (vlax-curve-getStartParam name)) (setq e (vlax-curve-getEndParam name)) (cond ( (member o '("LWPOLYLINE" "POLYLINE")) (repeat (setq i (1+ (fix e))) (setq l (cons (rp (vlax-curve-getPointAtParam name (setq i (1- i))) f) l)) ) ) ( (member o '("LINE" "SPLINE")) (setq l (list (rp (vlax-curve-getPointAtParam name s) f) (rp (vlax-curve-getPointAtParam name e) f) ) ) ) ( (member o '("ARC" "CIRCLE" "ELLIPSE")) (setq l (list (rp (cdr (assoc 10 (entget name))) f) (rp (vlax-curve-getPointAtParam name s) f) (rp (vlax-curve-getPointAtParam name e) f) ) ) ) ) ) l ) (and (setq blc (ssadd)) (not (initget "Sommet Trajet")) (setq mode (cond ((getkword "\nSélectionner les blocs selon [Sommet/Trajet] <Sommet> : ")) ("Sommet"))) (setq jsel (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE")))) (repeat (setq i (sslength jsel)) (setq name (ssname jsel (setq i (1- i))) pt-lst (get-pt-list name) tmp (ssget "_F" pt-lst '((0 . "INSERT"))) ) (repeat (setq n (sslength tmp)) (setq obj (ssname tmp (setq n (1- n))) pt (cdr (assoc 10 (entget obj))) ) (cond ( (= mode "Trajet") (ssadd obj blc) ) ( (= mode "Sommet") (if (member T (mapcar '(lambda (p) (equal p pt 10e-2)) pt-lst)) (ssadd obj blc) ) ) ) ) blc ) (not (sssetfirst)) (princ (strcat "\nUn total de " (itoa (sslength blc)) " blocs ont été sélectionnés à partir des " (itoa (sslength jsel)) " polylignes/lignes sélectionnés." ) ) (sssetfirst nil blc) ) (princ) ) Bisous, Luna
  14. @GEGEMATIC, Quand je parle d'outil je parle de lisp 🙂 Au même titre que ton (handent_explorer). J'ai juste un programme un peu différent pour ne pas avoir à le relancer à chaque fois justement. Il a quelques soucis mais c'est du détails en soit ^^ C'est la fonction (explore-dxf). Bisous, Luna
  15. Ahah, ne vous en faites pas, j'ai mon propre outil pour creuser les listes DXF ^^ Mon problème était juste que mon cerveau n'était pas branché pour tester avec ou sans remplacement de fenêtre ... Yes, je suis au courant que les VIEWPORT sont des entités pénibles et nécessitent une manipulation particulière pour être modifiées. Le problème de la commande VPLAYER c'est que c'est une commande donc...mes tests de programmes ne sont pas fructueux à mes yeux car le temps d'exécution est beaucoup trop long Mais je pense que je vais passer par _VPLAYER malgré tout car chat me paraît trop complexe pour rien. Bisous, Luna
  16. Oki, donc j'avais bon, juste que mon calque 0 n'avait aucun remplacement de fenêtre. Ce qui répond donc à ma question La réponse est non, donc si l'on veut créer un remplacement de fenêtre, il nous faut créer ces dictionnaires ADSK ? Je sens que je me prends la tête pour rien et je vais finir par utiliser _VPLAYER ^^" Désolée du dérangement 🙂 Bisous, Luna
  17. Coucou @Olivier Eckmann, Je m'intéresse justement à ce sujet, mais j'ai beau chercher et tester, je ne suis pas en mesure d'accéder à ces dictionnaires ci-dessous... Comment dois-je m'y prendre pour y accéder ? Car on parle ici de dictionnaire d'extension, or j'ai bien ceci : Explore-DXF in progress from "LAYER" (<Nom d'entité: 1c40c063900>) : | (-1 . <Nom d'entité: 1c40c063900>) | (0 . "LAYER") | (5 . "10") | (102 . "{ACAD_XDICTIONARY") | (360 . <Nom d'entité: 1c40c0609e0>) | (102 . "}") | (330 . <Nom d'entité: 1c40c063820>) | (100 . "AcDbSymbolTableRecord") | (100 . "AcDbLayerTableRecord") | (2 . "0") | (70 . 0) | (62 . 7) | (6 . "Continuous") | (290 . 1) | (370 . 0) | (390 . <Nom d'entité: 1c40c0638f0>) | (347 . <Nom d'entité: 1c40c063e00>) | (348 . <Nom d'entité: 0>) | End of exploration... à partir de (entget (tblobjname "LAYER" "0")) Donc j'ai bien un dictionnaire d'extension mais si je récupère ensuite les infos du dictionnaire d'extension, il est vide : Explore-DXF in progress from "DICTIONARY" (<Nom d'entité: 1c40c0609e0>) : | (-1 . <Nom d'entité: 1c40c0609e0>) | (0 . "DICTIONARY") | (330 . <Nom d'entité: 1c40c063900>) | (5 . "E6") | (100 . "AcDbDictionary") | (280 . 1) | (281 . 1) | End of exploration... J'ai essayé de voir via les fonctions de giles concernant les dictionnaires (depuis ce >>post<<) mais évidemment, cela me retourne nil à chaque fois. Je suppose que je m'y prend mal, mais je n'arrive pas à retrouver la démarche complète... Aurais-tu quelques infos sur comment accéder à ces dictionnaires d'extension pour chaque calque ? Sommes-nous d'accord que ces dictionnaires existent peu importe si le calque possède oui ou non des propriétés forcées dans des fenêtres ? Bisous, Luna
  18. Coucou, Ce n'est pas possible de faire des objets NETTOYER en arc de cercle, mais il est toujours possible de "simuler" un arc de cercle en transformant l'arc de cercle en un ensemble de segments droits suffisamment courts pour se rapprocher suffisamment de la courbure générale. Pour se faire, tu peux t'aider du LISP suivant par exemple : http://gilecad.azurewebsites.net/LISP/Arc2Seg.LSP Bisous, Luna
  19. Coucou, Je pense qu'il existe plusieurs version du LISP SOM sur le net, donc cela serait plus simple de savoir avec quelle version tu travailles. Un .dwg nous permettrait également de tester les modifications à apporter pour toi. Bisous, Luna
  20. Si jamais, je n'ai pas ajouté de messages d'aide pour les (getkdh) mais c'est possible d'en ajouter au besoin : il suffit juste de remplacer le dernier nil par une chaîne de caractères expliquant chaque option ou bien d'utiliser la fonction (LgT) pour avoir l'aide en anglais ou en français en fonction de la variable "LOCALE". Je ne suis pas fan de celui-là mais au moins il fait le job ^^' Bisous, Luna
  21. @lecrabe , @Steven, J'ai corrigé le code (ci-dessus) pour prendre une valeur par défaut des préfixes/suffixes à "". Bisous, Luna
  22. Coucou @Steven, Yes c'est justement le problème dont je faisais mention. Le problème c'est que (getstring) ne prend pas en compte les mots clés, et je n'ai pas d'AutoCAD sous la main présentement pour vérifier si un (getkword) initialisé avec le bit 7 de (initget) permet de renseigner une chaîne de caractères contenant des espaces ou non. Une autre solution serait de supprimer la valeur par défaut pour les préfixes et suffixes, permettant ainsi de considérer une chaîne de caractères vide comme une valeur acceptable pour les préfixes et suffixes (équivalent donc à la suppression de ces derniers). Merci pour les retours en tout cas :3 Bisous, Luna
  23. Coucou, Bon je n'ai pas vraiment le temps de le tester, je verrais chat demain 🙂 (defun c:ATTINCR (/ lst2str str2lst getkdh LgT LM:vl-setattributevalue break att val pas pre suf mode jsel i name) (vl-load-com) (defun lst2str (lst sep) (if lst (vl-string-left-trim sep (apply 'strcat (mapcar '(lambda (x) (strcat sep (vl-princ-to-string x))) lst) ) ) ) ) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun getkdh (fun pfx arg sfx dft hlp / get bit kwd msg val) (defun get (msg / v) (apply 'initget arg) (if (null (setq v (apply (car fun) (vl-remove nil (mapcar '(lambda (x) (if (vl-symbolp x) (vl-symbol-value x) x)) (cdr fun)))))) (setq v (cdr dft)) v ) ) (and (member (car fun) (list 'getint 'getreal 'getdist 'getangle 'getorient 'getpoint 'getcorner 'getkword 'entsel 'nentsel 'nentselp)) (= 'STR (type (cond (pfx) (""))) (type (cond (sfx) ("")))) (listp arg) (if (null (setq bit (car (vl-remove-if-not '(lambda (x) (= 'INT (type x))) arg)))) (setq bit 0) bit) (if (null (setq kwd (car (vl-remove-if-not '(lambda (x) (= 'STR (type x))) arg)))) (not kwd) (if (vl-string-search "_" kwd) (setq kwd (mapcar 'cons (str2lst (car (str2lst kwd "_")) " ") (str2lst (cadr (str2lst kwd "_")) " "))) (setq kwd (mapcar 'cons (str2lst kwd " ") (str2lst kwd " "))) ) ) (if hlp (if (not (assoc "?" kwd)) (setq kwd (append kwd '(("?" . "?")))) T ) T ) (cond ( (null dft) (not dft)) ( (member dft (mapcar 'car kwd)) (setq dft (assoc dft kwd)) ) ( (member dft (mapcar 'cdr kwd)) (setq dft (nth (vl-position (car (member dft (mapcar 'cdr kwd))) (mapcar 'cdr kwd)) kwd)) ) ( T (setq dft (cons (vl-princ-to-string dft) dft))) ) (if (and dft (= 1 (logand 1 bit))) (setq bit (1- bit)) T) (setq arg (vl-remove nil (list bit (lst2str (vl-remove nil (list (lst2str (mapcar 'car kwd) " ") (lst2str (mapcar 'cdr kwd) " "))) "_")))) (if (or pfx kwd dft sfx) (setq msg (strcat (cond (pfx) ("")) (if kwd (strcat " [" (lst2str (mapcar 'car kwd) "/") "]") "") (if dft (strcat " <" (car dft) ">") "") (cond (sfx) ("")) ) ) (not (setq msg nil)) ) (if hlp (while (= "?" (setq val (get msg))) (cond ( (listp hlp) (eval hlp)) ((princ hlp)) ) ) (setq val (get msg)) ) ) val ) (defun LgT (en fr) (if (= (getvar "LOCALE") "FR") fr en ) ) (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) (if (not *AttI-Tag*) (setq *AttI-Tag* "XXX")) (if (not *AttI-Val*) (setq *AttI-Val* 1)) (if (not *AttI-Pas*) (setq *AttI-Pas* 1)) (while (not break) (setq att (getkdh (quote (nentsel msg)) (LgT "\nPlease select an attribute or" "\nVeuillez sélectionner un attribut ou" ) (list (LgT "Name eXit _Name eXit" "Nommer Quitter _Name eXit")) " : " "Name" nil ) ) (cond ( (= "eXit" att) (setq break T)) ( (= "Name" att) (cond ( (= "" (setq att (getstring (strcat (LgT "\nSpecify the tag name <" "\nRenseignez le nom d'étiquette <") *AttI-Tag* "> : ")))) (setq att *AttI-Tag*) ) (att) ) (setq break T) ) ( (and (listp att) (setq att (car att)) (= "ATTRIB" (cdr (assoc 0 (entget att)))) ) (setq att (cdr (assoc 2 (entget att)))) (setq break T) ) ( T (princ (LgT "\nError on selection, try again please..." "\nErreur lors de la sélection, veuillez réessayer...")) ) ) ) (and att (setq *AttI-Tag* att) (not (setq break nil)) (while (not break) (princ (strcat (LgT "\nStep = " "\nPas = ") (itoa (cond (pas) (*AttI-Pas*))) (LgT " | Prefix = \"" " | Préfixe = \"") (cond (pre) ("")) "\"" (LgT " | Suffix = \"" " | Suffixe = \"") (cond (suf) ("")) "\"" ) ) (setq val (getkdh (quote (getint msg)) (LgT "\nStarting value" "\nValeur de départ") (list (LgT "steP prEfix sUffix _steP prEfix sUffix" "Pas prEfixe sUffixe _steP prEfix sUffix")) " : " *AttI-Val* nil ) ) (cond ( (= "steP" val) (setq pas (getkdh (quote (getint msg)) (LgT "\nSpecify the step" "\nSpécifiez le pas") (list 2) " : " (itoa *AttI-Pas*) nil)) ) ( (= "prEfix" val) (setq pre (getstring T (LgT "\nPrefix <> : " "\nPréfixe <> : ")))) ( (= "sUffix" val) (setq suf (getstring T (LgT "\nSuffix <> : " "\nSuffixe <> : ")))) ( (numberp val) (setq pas (cond (pas) (*AttI-Pas*)) *AttI-Pas* pas pre (cond (pre) ("")) suf (cond (suf) ("")) *AttI-Val* val break T ) ) ) ) (setq n 0) (setq mode (getkdh (quote (getkword msg)) (LgT "\nSelection mode" "\nMode de sélection") (list (LgT "Auto Manual _Auto Manual" "Auto Manuel _Auto Manual")) " : " "Manual" nil ) ) (cond ( (and (= "Auto" mode) (setq jsel (ssget '((0 . "INSERT") (66 . 1))))) (repeat (setq i (sslength jsel)) (setq name (ssname jsel (setq i (1- i)))) (if (LM:vl-setattributevalue (vlax-ename->vla-object name) att (strcat pre (itoa val) suf)) (setq val (+ val pas) n (1+ n) ) ) ) T ) ( (and (= "Manual" mode) (not (setq break nil))) (while (not break) (princ (strcat (LgT "\nTag = " "\nEtiquette = ") (strcase att))) (setq name (getkdh (quote (entsel msg)) (LgT "\nPlease select a block with attributes" "\nVeuillez sélectionner un bloc avec attribut") (list (LgT "eXit _eXit" "Quitter _eXit")) " : " "eXit" nil ) ) (cond ( (= "eXit" name) (setq break T)) ( (and (listp name) (setq name (car name)) (= "INSERT" (cdr (assoc 0 (entget name)))) (= 1 (cdr (assoc 66 (entget name)))) ) (if (LM:vl-setattributevalue (vlax-ename->vla-object name) att (strcat pre (itoa val) suf)) (setq val (+ val pas) n (1+ n) ) ) ) ( T (princ (LgT "\nError on selection, try again please..." "\nErreur lors de la sélection, veuillez réessayer..."))) ) ) T ) ) (princ (strcat (LgT "\nA total of " "\nUn total de ") (itoa n) (LgT " block has been modified succesfully..." " blocs ont été modifiés avec succès...") ) ) ) (princ) ) Le défaut que j'ai constaté c'est la réinitialisation des préfixes/suffixes à une valeur nulle (en raison de la valeur par défaut qui empêche de considérer un string vide). Et je testé très vite fait, chat semble fonctionnel mais je suis persuadée que je me suis emmêlée les pinceaux ^^" MOD : Modification du code pour une valeur par défaut de préfixe/suffixe = "" Bisous, Luna
  24. oki doki je vois. Je vais voir chat alors
  25. @lecrabe, Je viens de remarquer un truc qui pourrait être utile d'un point de vue information : comment dois-je "trier" la sélection des blocs pour incrémenter la valeur suivant un ordre désiré ? Car avec un (ssget), difficile de savoir quel bloc doit être à 1, puis à 2, etc... ^^ Donc faut-il prévoir un tri graphique ? Un tri manuel, donc pas de (ssget) mais un (entsel) dans une boucle (while) par exemple ? Pas de tri et l'utilisateur croise les doigts ? Tu ne m'en voudras pas trop j'espère mais j'ai préféré partir sur une base saine à partir de mes fonctions persos et j'ai ajouter un peu d'ergonomie pour les utilisateurs 🙂 Je posterais le programme une fois que je saurais comment trier mes blocs pour une incrémentation désirée par l'utilisateur ! Bisous, Luna
×
×
  • 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é