nen

Bonjour à tous, Merci, lecrabe, pour ton message. J'ai réussi à obtenir un résultat qui me convient, mais j'ai un petit souci avec un format spécifique : je n'arrive pas à faire en sorte que tous les formats soient acceptés. Je souhaite que le Lisp prenne en charge les formats suivants : "AB-1-100", "ABC-1-100.1", "ABC-100", "ABC.100", "100" et "A1". Il fonctionne correctement avec presque tous, sauf pour le format "A1". Je n'arrive pas à faire en sorte que le code accepte une lettre suivie d'un chiffre. Pour mon usage, cela me convient, mais si quelqu'un avait la gentillesse de corriger cela, ce serait topissime ! Merci à tous pour votre aide. Cordialement. (defun find-last-hyphen (str) "Trouve la position du dernier tiret dans une chaîne." (setq pos nil idx 0) (while (setq idx (vl-string-search "-" str idx)) (setq pos idx idx (1+ idx)) ) pos ) (defun find-last-number (str) "Récupère la partie numérique d'une chaîne en conservant les lettres initiales." (vl-string-right-trim "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" str) ) (defun incremente-numero (str) "Incrémente intelligemment le dernier segment numérique dans un identifiant complexe." (setq pos-hyphen (find-last-hyphen str)) (setq last-part "") ;; Séparation du préfixe et du dernier élément numérique (if pos-hyphen (progn (setq prefix (substr str 1 (+ pos-hyphen 1))) ;; Inclut le dernier tiret (setq last-part (substr str (+ pos-hyphen 2))) ;; Partie après le dernier tiret ) (setq prefix "" last-part str) ;; Aucun tiret, tout est traité comme un numéro ) ;; Cas où la partie après le dernier tiret contient un point (if (vl-string-search "." last-part) (progn (setq pos-point (vl-string-search "." last-part)) (setq base (substr last-part 1 pos-point)) ;; Partie entière avant le point (setq decimal (substr last-part (+ pos-point 2))) ;; Partie après le point (setq new-decimal (itoa (1+ (atoi decimal)))) ;; Incrémentation de la partie décimale (strcat prefix base "." new-decimal) ) ;; Cas où la partie est un mix de lettres et chiffres (ex: "A1") (if (vl-string-search "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" last-part) (progn (setq numeric-part (find-last-number last-part)) (setq letter-part (substr last-part 1 (- (strlen last-part) (strlen numeric-part)))) (strcat prefix letter-part (itoa (1+ (atoi numeric-part)))) ) ;; Cas par défaut : simple incrémentation numérique (strcat prefix (itoa (1+ (atoi last-part)))) ) ) ) (defun BLP7 () (setq lst '()) ;; Liste des sommets (setq ent (car (entsel "\nSélectionnez une polyligne : "))) (if (and ent (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")) (progn (setq obj (vlax-ename->vla-object ent)) (setq n (vla-get-NumberOfVertices obj)) (setq i 0) (while (< i n) (setq pt (vlax-safearray->list (vlax-variant-value (vla-GetCoordinate obj i)))) (setq lst (append lst (list pt))) (setq i (1+ i)) ) (princ "\nSommets détectés :") (setq idx 0) (foreach p lst (princ (strcat "\n[" (itoa idx) "] -> " (rtos (car p) 2 3) ", " (rtos (cadr p) 2 3))) (setq idx (1+ idx)) ) ;; Sélection du sommet de départ (setq sp (getpoint "\nCliquez sur le sommet de départ : ")) (setq startIndex 0 minDist nil idx 0) (foreach pt lst (setq d (distance sp pt)) (if (or (null minDist) (< d minDist)) (progn (setq minDist d startIndex idx)) ) (setq idx (1+ idx)) ) (princ (strcat "\nSommet de départ: " (itoa startIndex))) ;; Saisie du numéro de départ (setq numero (getstring t "\nEntrez le numéro de départ (ex: AB-1-100, ABC-1-100.1, ABC-100, ABC.100, 100 ou A1) : ")) ;; Génération des numéros pour chaque sommet (setq numList (list numero)) (setq i 1) (while (< i n) (setq numero (incremente-numero numero)) (setq numList (append numList (list numero))) (setq i (1+ i)) ) ;; Affichage des numéros générés (princ "\nNumérotation générée :") (setq idx 0) (foreach num numList (princ (strcat "\n[" (itoa idx) "] -> " num)) (setq idx (1+ idx)) ) ) (princ "\nErreur : sélection invalide.") ) (princ) )

Bonjour le Forum👋, Merci à vous deux pour vos messages😉. Je vais répondre à vos questions et vous envoie en pièce jointe un fichier DWG contenant le bloc en question. Oui, tous les éléments graphiques sont bien définis et placés sur le calque "0" en mode "DuCalque". Oui, les attributs sont bien en mode visible. Oui, le calque "INFORMATIONS" est actif, visible et non verrouillé. Concernant le fonctionnement du code, il est difficile de répondre avec certitude. Je constate que les blocs sont bien insérés, mais comme ils ne s'affichent pas, je ne peux pas vérifier si l'incrémentation fonctionne correctement. Maintenant que tu en parles, il est possible que mon code importe uniquement les blocs sans leurs attributs. Tu as peut-être raison🤔. Meilleures salutations Dessin1.dwg

Bonjour le Forum, J'ai besoin de votre aide. Le code ci-dessous est censé insérer un bloc (contenant deux attributs "DESIGNATION" et "LOCAL") à chaque sommet d'une polyligne (chemin). Après avoir sélectionné la polyligne, il demande un point de départ, puis un numéro de départ, puis incrémente ce numéro de 1 pour chaque sommet de la polyligne et insère le bloc à ces positions. Le problème est que les blocs sont bien insérés, mais je ne parviens pas à les voir ni à les sélectionner. La seule façon de les localiser est en utilisant leur "Handle", et si j'explose un bloc, les attributs deviennent visibles. Je ne comprends pas. Si quelqu'un pouvait m'aider et m'expliquer pourquoi je ne peux pas voir les blocs, ce serait sympa. (defun c:InsertInfoLocaux (/ ent obj pts p0 num prefix suffix count blkName blkLayer blkScale blkRotation objType vertexList i coordList blkEnt attrEnt insPt) (setq blkName "LOCAUX" ;; Nom du bloc blkLayer "INFORMATIONS" ;; Nom du calque blkScale 1.0 blkRotation 0.0) ;; Vérifier si le bloc existe dans le dessin (if (not (tblsearch "BLOCK" blkName)) (progn (princ "\nErreur : Le bloc LOCAUX n'existe pas dans le dessin.") (exit))) ;; Sélection de la polyligne (setq ent (car (entsel "\nSélectionnez une polyligne : "))) (if (and ent (setq obj (vlax-ename->vla-object ent)) (setq objType (cdr (assoc 0 (entget ent)))) (or (eq objType "LWPOLYLINE") (eq objType "POLYLINE"))) (progn ;; Récupération des sommets (setq pts (cond ;; Polyligne légère (LWPOLYLINE) ((eq objType "LWPOLYLINE") (setq coordList (vlax-get obj 'Coordinates) pts '() i 0) (while (< i (length coordList)) (setq pts (append pts (list (list (nth i coordList) (nth (1+ i) coordList) 0)))) (setq i (+ i 2))) pts) ;; Polyligne 2D (avec sommets VERTEX) ((eq objType "POLYLINE") (setq vertexList '()) (setq ent (entnext ent)) (while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND")) (if (= (cdr (assoc 0 (entget ent))) "VERTEX") (setq vertexList (append vertexList (list (cdr (assoc 10 (entget ent)))))) ) (setq ent (entnext ent)) ) vertexList ) )) (if pts (progn ;; Sélection du point de départ (setq p0 (getpoint "\nSélectionnez le point de départ : ")) ;; Demande du numéro de départ (setq num (getstring "\nEntrez le numéro de départ (ex: SURFACE-01) : ")) ;; Séparation du préfixe et du suffixe (setq prefix (vl-string-left-trim "0123456789" num) suffix (atoi (vl-string-right-trim prefix num))) ;; Création du calque si nécessaire (if (not (tblsearch "LAYER" blkLayer)) (entmakex (list (cons 0 "LAYER") (cons 2 blkLayer) (cons 62 1)))) ;; Insérer les blocs sur chaque sommet (setq count 0) (foreach pt pts (setq insPt pt) (setq blkEnt (entmakex (list (cons 0 "INSERT") (cons 2 blkName) (cons 8 blkLayer) (cons 10 insPt) (cons 41 blkScale) ;; X scale (cons 42 blkScale) ;; Y scale (cons 43 blkScale) ;; Z scale (cons 50 blkRotation) ) ) ) (if blkEnt (progn (setq suffix (+ suffix 1)) (setq attrEnt (entnext blkEnt)) (while (and attrEnt (/= (cdr (assoc 0 (entget attrEnt))) "SEQEND")) (if (eq (cdr (assoc 2 (entget attrEnt))) "LOCAL") (entmod (subst (cons 1 (strcat prefix (itoa suffix))) (assoc 1 (entget attrEnt)) (entget attrEnt))) ) (setq attrEnt (entnext attrEnt)) ) (princ (strcat "\nBloc inséré au point : " (rtos (car insPt)) ", " (rtos (cadr insPt)))) ) (princ "\nErreur lors de l'insertion du bloc.") ) (setq count (+ count 1)) ) ;; Forcer le rafraîchissement d'AutoCAD (command "REGEN") ) (princ "\nAucun sommet trouvé sur la polyligne sélectionnée.") ) ) (princ "\nErreur : Veuillez sélectionner une polyligne.") ) (princ) )

Bonjour ✋, Je te remercie Gile pour ces précisions supplémentaires🙂. J'ai testé ta version ces derniers jours et elle fonctionne parfaitement👍. Merci à toi aussi, Luna, pour ton aide😉. Meilleures salutations

Bonjour Gile, Merci beaucoup pour ton lien🙂. J'ai effectivement testé le LISP "mbbox", et bien qu'il fonctionne, il ne répond pas exactement à mes attentes. Je souhaiterais que, lorsque je sélectionne 4 blocs, une boîte englobante soit créée pour chacun d'entre eux. Bonjour Luna, Merci beaucoup pour ton aide. J'ai corrigé le problème avec (code DXF 66)😉, et maintenant mon code fonctionne... enfin presque🤔. Pour les blocs contenant plusieurs attributs, il ne crée une boîte englobante que pour le dernier attribut. Après de nombreux essais, je me suis tourné vers le code de base de Lee Mac, " LM :boundingbox", et cela fonctionne, mais les boîtes englobantes (cadres) ne sont pas placées correctement(image ci-joint). Aurais-tu une idée pour résoudre ce problème ? (defun c:BoxBlocAttrib23 ( / ss i Ent ObjType bbox Decal) (setq oldcmd00 (getvar "cmdecho")) (setvar "cmdecho" 0) ;; Demander la sélection des blocs avec attributs (code DXF 66) (setq ss (ssget '((0 . "INSERT") (66 . 1)))) (setq Decal (getdist "\nDécalage ? <10> : ")) (if (= Decal nil)(setq Decal 10)) ; Par défaut, décalage de 10 si aucune entrée ;; Créer ou définir le calque "Rectangle" avec une couleur verte (if (not (tblsearch "layer" "Rectangle")) (progn (command "_.-layer" "_Make" "Rectangle" "_Color" "Vert" "" "") ) (command "_.-layer" "_Set" "Rectangle" "") ) ;; Boucler sur chaque bloc sélectionné (setq i 0) (while (< i (sslength ss)) (setq Ent (ssname ss i)) (setq ObjType (cdr (assoc 0 (entget Ent)))) ; Récupérer le type d'objet ;; Si c'est un bloc avec attributs (if (eq ObjType "INSERT") (progn ;; Récupérer la boîte englobante du bloc (setq bbox (LM:boundingbox (vlax-ename->vla-object Ent))) ;; Si une boîte englobante est trouvée (if bbox (progn ;; Décaler les points de la boîte englobante (setq Pt1 (list (- (car (car bbox)) Decal) (- (cadr (car bbox)) Decal))) (setq Pt2 (list (+ (car (cadr bbox)) Decal) (+ (cadr (cadr bbox)) Decal))) ;; Dessiner le rectangle sur le calque "Rectangle" (command "_rectang" Pt1 Pt2) ) ) ) ) ;; Passer à l'objet suivant (setq i (1+ i)) ) ;; Restaurer les paramètres initiaux (setvar "cmdecho" oldcmd00) (princ) ) ;; Fonction pour obtenir la boîte englobante d'un objet donné (defun LM:boundingbox ( obj / llp urp ) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (list (vlax-safearray->list llp) (vlax-safearray->list urp)) ) ) BoxBlocAttrib23.lsp

Bonjour le forum🙂, Je sollicite votre aide pour un problème que nous rencontrons. Depuis plusieurs mois, mon collègue et moi, qui sommes de véritables novices en Lisp, travaillons sur un code ci-dessous pour créer une boîte englobante (rectangle) autour d'une sélection de blocs contenant plusieurs attributs. Nous souhaitons que cette boîte (rectangle) soit placée sur le calque "Rectangle" en couleur verte, et nous aimerions inclure une option pour demander un décalage. Nous avons essayé d'intégrer différents morceaux de code sans succès. Si quelqu'un pouvait jeter un coup d'œil à notre code, ce serait vraiment sympa😉. Merci d'avance pour votre aide ! (defun c:BoxBlocAttrib ( / ss i Ent ObjType AttribList Bbox MinPt MaxPt Pt1 Pt2 Pt3 Pt4 Decal) (setq oldcmd00 (getvar "cmdecho")) (setvar "cmdecho" 0) ;; Fonction pour décaler un point (defun DeltaXY (Pt1 DeltaX DeltaY) (list (+ (car Pt1) DeltaX) (+ (cadr Pt1) DeltaY) ) ) ;; Fonction pour calculer la boîte englobante entre deux points (defun AddToBoundingBox (bbox point) (setq MinPt (mapcar 'min (car bbox) point)) (setq MaxPt (mapcar 'max (cadr bbox) point)) (list MinPt MaxPt) ) ;; Demander la sélection des blocs (setq ss (ssget '((0 . "INSERT")))) ; Sélection des blocs (setq Decal (getdist "\nDécalage ? <10> : ")) (if (= Decal nil)(setq Decal 10)) ;; Créer ou définir le calque "Rectangle" avec une couleur verte (if (not (tblsearch "layer" "Rectangle")) (progn (command "_.-layer" "_Make" "Rectangle" "_Color" "Vert" "" "") ) (command "_.-layer" "_Set" "Rectangle" "") ) ;; Boucler sur chaque bloc sélectionné (setq i 0) (while (< i (sslength ss)) (setq Ent (ssname ss i)) (setq ObjType (cdr (assoc 0 (entget Ent)))) ; Récupérer le type d'objet ;; Initialiser la boîte englobante (setq Bbox nil) ;; Si c'est un bloc avec attributs, on récupère les attributs et leur boîte englobante (if (eq ObjType "INSERT") (progn (setq AttribList (entnext Ent)) (while (and AttribList (eq (cdr (assoc 0 (entget AttribList))) "ATTRIB")) (command "_ucs" "_Entity" AttribList) (setq Tb_list (textbox (list (cons -1 AttribList)))) (setq Pt1 (car Tb_list)) (setq Pt2 (cadr Tb_list)) (if Bbox (setq Bbox (AddToBoundingBox Bbox Pt1)) (setq Bbox (list Pt1 Pt2)) ) (setq Bbox (AddToBoundingBox Bbox Pt2)) (setq AttribList (entnext AttribList)) ) ;; Décaler les points de la boîte englobante (setq Pt1 (car Bbox)) (setq Pt1 (DeltaXY Pt1 (* Decal -1) (* Decal -1))) (setq Pt2 (cadr Bbox)) (setq Pt2 (DeltaXY Pt2 Decal Decal)) (setq Pt3 (list (car Pt1) (cadr Pt2))) (setq Pt4 (list (car Pt2) (cadr Pt1))) ;; Dessiner le rectangle sur le calque "Rectangle" (command "_layer" "_set" "Rectangle" "") (command "_rectang" Pt1 Pt2) ;; Restaurer le SCU (système de coordonnées utilisateur) (command "_ucs" "_p") ) ) ;; Passer à l'objet suivant (setq i (1+ i)) ) (setvar "cmdecho" oldcmd00) (princ) )

Bonjour Luna👋, Merci beaucoup pour ta réponse et pour le code que tu m'as fourni. Je vais l'essayer dès que possible. Encore merci pour ton aide précieuse ! À bientôt,

Bonjour le Forum, Je sollicite votre aide🙂. J'utilise le Lisp créé par Giles, "zoombyhandle", et j'ai essayé de le modifier en ajoutant un champ de recherche. En effet, il m'arrive souvent de travailler sur des plans contenant de nombreux blocs "handle", et il est fastidieux de les trouver en utilisant la barre de défilement. De plus, leur code est parfois difficile à trouver dans la liste. J'ai donc ajouté un champ de recherche qui ne fonctionne pas correctement, c'est le zoom qui ne se centre pas sur le bon élément. Quelqu'un pourrait-il m'aider ?🤔 Merci d'avance. (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 filter-list (lst search-term) (if (not (vl-string-search "" search-term)) lst (vl-remove-if-not '(lambda (item) (vl-string-search search-term item)) lst ) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice search-term filtered-list) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w")) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file)) (write-line ":edit_box{key=\"search\";edit_width=20;}" file) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file) (write-line "}spacer;ok_cancel;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit)) (defun update-list (search-term) (setq filtered-list (filter-list (mapcar 'cdr keylab) search-term)) (start_list "lst") (mapcar 'add_list filtered-list) (end_list) ) (action_tile "search" "(update-list $value)") (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))) (setq choice (reverse choice))) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))))) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) (defun c:zoombyhandle ( / js n hdt l_hdt) (setq js (ssget "_X")) (cond (js (setq l_hdt nil) (repeat (setq n (sslength js)) (setq hdt (cdr (assoc 5 (entget (ssname js (setq n (1- n))) ) ) ) ) (if hdt (setq l_hdt (cons hdt l_hdt))) ) (command "_zoom" "_object" (cdar (entget (handent (ListBox "HANDLES du dessin" "Choisir UN handle" (mapcar 'cons l_hdt l_hdt) 1)))) "") ) ) (prin1) )

Je vous remercie pour vos messages👍. Eh bien, c'est ça. Je dois confondre entre les deux processus😱. Je pensais que redéfinir le bloc mettait à jour toutes les caractéristiques du bloc et des attributs inclu et je ne comprenais pas pourquoi certaines caractéristiques changeaient et d'autres non🤔. Après avoir effectué des tests, si j'ai bien compris lorsque l'on redéfinit un bloc lors de son insertion, cela modifie la géométrie du bloc (le dessin) et non les attributs. Pour effectuer le changement des attributs, il faut utiliser la commande ATTSYNC. Je me doutais bien qu'il devait y avoir une commande dédiée🙂. Il serait utile qu'AutoCAD, lors de l'importation du bloc, pose également la question d'utiliser ATTSYNC dès qu'il détecte la présence d'attributs. Merci de votre aide😉.

Bonjour le forum, J'ai une question concernant les blocs comportant des attributs. Actuellement, j'ai un bloc avec quatre attributs créés sur le calque 0 (sauf le premier attribut qui est sur le calque defpoint), conformément aux recommandations d'Autodesk. Cependant, lors de l'importation du bloc dans le dessin, il est positionné sur le calque "texte", ce qui n'est pas souhaité dans mon cas. Pour des raisons qui sont un peu longues à expliquer, j'aurais besoin, dans mon utilisation quotidienne, de modifier le calque de création de l'attribut et de le placer sur le calque "texte". Ainsi, j'ai créé une copie du bloc sur laquelle j'ai déplacé les attributs vers le calque "texte"(sauf le premier attribut qui est sur le calque defpoint). Cependant, lors de la réimportation du bloc, en acceptant la question "Redéfinir le bloc", je m'attends à ce que cela modifie les calques, mais cela ne se produit pas. Existe-t-il une commande spécifique pour effectuer cette opération ? Merci pour votre aide.

Super merci, cela a fonctionné 🙂👍

Bonjour le forum, J’aurais besoin d’un peu d’aide… pour changer😄. J'utilise SuperAutoScript de Caderix pour créer et exécuter des scripts. J'utilise un Lisp (https://cadxp.com/topic/36680-benchmark-dans-autocad/) pour effectuer des tests (benchmark) de performance sur différentes machines. L'objectif est de charger et exécuter le script de manière à ce qu'il importe un plan, charge le Lisp, puis exécute le test. Est-ce possible de charger et exécuter un lisp avec un script ? Meilleures salutations

Bonjour Luna, Désolé mes infos n'ont pas été claire, je joint une image qui sera plus parlant. @+

Bonjour Luna, Je te remercie pour ton aide👍. Ton code fonctionne de manière optimale. Néanmoins, il présente un inconvénient en supprimant le texte de l'invite. Serait-il envisageable d'éviter cette suppression ? En effet, cette problématique répond à un besoin spécifique. Je suis fréquemment amené à recevoir des plans au format DWG provenant de diverses entreprises, chacune ayant ses propres attributs spécifiques. À chaque fois que des corrections sont nécessaires, cela requiert des solutions spécifique. Il me semble qu'Autodesk aurait pu développer des commandes spécifique aux attributs pour faciliter notre travail, surtout lorsque les blocs avec attributs sont mal conçus. @+ Meilleures salutations

Bonjour le forum, J'aimerais solliciter vos connaissances sur deux points. Tout d'abord, j'utilise actuellement un lisp "RENAMETAG" de Gile qui fonctionne très bien, mais je me demande s'il serait envisageable de l'améliorer. Actuellement, ce lisp me demande à la fois l'ancienne et la nouvelle étiquette. Cependant, dans la plupart des cas, mes blocs possèdent trois ou quatre attributs, ce qui nécessite entre 6 et 8 opérations de copier/coller. Serait-il envisageable d'ajouter directement ces informations dans le lisp et de simplement sélectionner les blocs concernés ? Ensuite, en ce qui concerne le lisp "CATP" de "Patrick_35", je me demandais s'il serait possible d'ajouter une fonctionnalité de sélection à la volée. Cela éviterait d'avoir à le retaper la commande à chaque utilisation. Je vous remercie d'avance pour vos suggestions et vos idées. CatP.lsp RENAMETAG.lsp