bonuscad

Ça ne dira pas où est le problème, mais si tu rentre une distance négative, cela étire du bon côté? Si c'est le cas c'est peut être lié au sens de création de l'objet, ou une création (ou un miroir) en vue de dessous (0 0 -1)...

Je ne sais pas si cette procédure d'AutoDesk est toujours d'actualité: How to detect and remove the AutoCAD.vlx virus

Tu as eu la réponse en stéréo ... :(rires forts): :(rires forts): :(rires forts):

Bonjour, Très bien! Utilise une(ou plusieurs) propriété personnalisée du dessin, ainsi en changeant ultérieurement cette propriété, tous tes champs se mettront à jour dans l'onglet où ils se trouvent. Commande: PROPDESS (_DWGPROPS)

Pour être un peu plus précis, je dirais une arborescence de liste de niveau d’imbrication différente. Pour imager le (car) pourrait être le nœud et le (cdr) la branche de l'arborescence restante.

Pour ma part, je préfère cette syntaxe qui offrirait plus de souplesse, tient compte de l'onglet et de l'espace courant. (setq ss (ssget "_A" (list '(0 . "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) Pas très utile la double parenthèse encadrant defun ...

Ma version: (defun c:test ( / lste) (setq Lste '( ("fdffg" "FDFFG" "1234" "4569" "22" ) ("fdifg" "FDIFG" "1224" "4569" "22" ) ("mdffg" "MDFFG" "1434" "4569" "22" ) ("adffg" "ADFFG" "1234" "4169" "22" ) ) ) (CheckList (strcase (getstring T "\nTapez la chaine à trouver: ") nil) (getint "\nA la position: ") Lste) ) (defun checklist (str pso lst / nw_lst) (mapcar '(lambda (x) (if (setq pos (vl-position str x)) (if (eq (1+ pos) pso) (setq nw_lst (cons x nw_lst)) ) ) ) lst ) nw_lst )

Salut Fraid, Pas bien suivi non plus ton ennoncé... Ca veux dire la position occupé (1er élément, 2ème etc..) J'ai l'impression que tu te fourvois avec (nth), il y a un décalage... (nth 0 liste) -> renvoie le 1er élément. (nth 1 liste) -> renvoie le 2ème élément. (nth 2 liste) -> renvoie le 3ème élément. (et pas le second ;) ) Il faudrait vraiment que tu donnes la liste en retour que tu souhaite obtenir quand tu soumet la liste de départ à ta fonction AVEC les arguments qui vont bien. Car là tu parles d'une clé string au départ du post et puis de position dans la liste par la suite sans plus parler de clé...

C'est un fichier ARX: acxplode.arx Malheuresement dans ce type de fichier tu ne pourras rien voir en clair. Pour ta culture, je te fais un copier-coller de cette fonction telle qu'elle est parue sous la version R14. Je ne peux te certifier qu'elle soit une bonne image de celle utilsée dans les version de nos jours... ;;;--------------------------------------------------------------------------; ;;; XPLODE.LSP ;;; Copyright 1990, 1992, 1994, 1996 by Autodesk, Inc. ;;; Permission to use, copy, modify, and distribute this software ;;; for any purpose and without fee is hereby granted, provided ;;; that the above copyright notice appears in all copies and ;;; that both that copyright notice and the limited warranty and ;;; restricted rights notice below appear in all supporting ;;; documentation. ;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. ;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF ;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC. ;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE ;;; UNINTERRUPTED OR ERROR FREE. ;;; Use, duplication, or disclosure by the U.S. Government is subject to ;;; restrictions set forth in FAR 52.227-19 (Commercial Computer ;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) ;;; (Rights in Technical Data and Computer Software), as applicable. ;;; --------------------------------------------------------------------------; ;;; DESCRIPTION ;;; This is a replacement for the EXPLODE command in AutoCAD. It allows ;;; you to control all of the properties of the component entities of a ;;; block or set of blocks while exploding them. There are several major ;;; differences between XPlode and the EXPLODE command in AutoCAD. ;;; First, you can select as many entities as you wish; all dimensions, ;;; polyline and polymeshes, and block insertions will be extracted from ;;; your selection set, and you will be asked to XPlode them either ;;; globally or individually. If you chose to explode them globally, you ;;; will see the following prompt for all of the candidate entities: ;;; All/Color/LAyer/LType/Inherit from parent block/<Explode>: ;;; If, on the other hand, you elect to operate on each element of the ;;; selection set individually, you will need to make a selection from this ;;; prompt for each entity to be exploded. ;;; Second, the EXPLODE command in AutoCAD does not allow you to specify ;;; any of the properties for the resulting entities generated from the ;;; EXPLODE command. Nor does it allow you to let the component entities ;;; inherit the attributes of the parent block. ;;; Third, this routine allows blocks inserted with equal absolute scale ;;; factors but differing signs to be exploded (i.e. -1,1,1). This allows ;;; mirrored blocks to be exploded. ;;; ALL ;;; This option allows you to specify a color, linetype, and layer for the ;;; new entities. ;;; COLOR ;;; This option prompts you for a new color for the component entities. ;;; New color for exploded entities. ;;; Red/Yellow/Green/Cyan/Blue/Magenta/White/BYLayer/BYBlock/<cecolor>: ;;; You may enter any color number from 1 through 255, or one of the ;;; standard color names listed. "Cecolor" is the current entity color ;;; from the CECOLOR system variable. ;;; LAYER ;;; This option prompts you to enter the name of the layer on which you ;;; want the component entities to be placed. ;;; XPlode onto what layer? <clayer>: ;;; The layer name entered is verified and if it does not exist you are ;;; reprompted for a layer name. Pressing RETURN causes the current ;;; layer to be used. ;;; LTYPE ;;; This option lists all of the loaded linetypes in the current drawing, ;;; and prompts you to choose one of them. You must type the entire ;;; linetype name (sorry), or you may press RETURN to use the current one. ;;; Choose from the following list of linetypes. ;;; CONTinuous/...others.../<CONTINUOUS>: ;;; INHERIT ;;; Inherit from parent block means that the attributes of the block ;;; being XPloded will be the attributes of component entities. No other ;;; choices are required. ;;; EXPLODE ;;; This option issues the current EXPLODE command for each of the entities ;;; in the selection set. ;;; --------------------------------------------------------------------------; ;;; ------------------------ INTERNAL ERROR HANDLER --------------------------; (defun xp_err (s) ; If an error (such as CTRL-C) occurs ;; while this command is active... (if (/= s "Fonction annulée") (princ (strcat "\n Erreur : " s)) ) (if xp_oce (setvar "cmdecho" xp_oce)) ; restore old cmdecho value (setq *error* olderr) ; restore old *error* handler (princ) ) ;;; ---------------------------- COMMON FUNCTION -----------------------------; (defun xp_val (n e f) (if f ; if f then e is an entity list. (cdr (assoc n e)) (cdr (assoc n (entget e))) ) ) ;;; ------------------------- GET ENTITY TO EXPLODE --------------------------; ;;; ---------------------------- MAIN PROGRAM --------------------------------; (defun explode ( / oce ohl e0 en e1 s0) (setq xp_oer *error* *error* xp_err) (setq xp_oce (getvar "cmdecho")) ; save value of cmdecho (setvar "cmdecho" 0) ; turn cmdecho off (graphscr) (princ "\n Choix des objets à décomposer. ") (setq ss (ssget)) (if ss (progn ;; Sort out any entities not explodeable... (setq ss (xp_sxe)) ; DLine_Sort_Xplodable_Entities ;; XPlode Individually or Globally? (if (> (sslength ss) 0) (progn (if (> (sslength ss) 1) (progn (initget "Individuellement Globalement") (setq ans (getkword "\n\n Décomposer Individuellement/<Globalement>: ")) ) (setq ans "Globalement") ) (cond ((= ans "Individuellement") (setq sslen (sslength ss) j 0) (while (< j sslen) (setq temp (ssname ss j) prmpt T) (redraw temp 3) (setq typ (xp_gxt)) (xp_xpe temp typ) (redraw temp 4) (setq j (1+ j)) ) ) (T (setq sslen (sslength ss) j 0 ans "Globalement" prmpt T) (setq typ (xp_gxt)) (while (< j sslen) (setq temp (ssname ss j)) (xp_xpe temp typ) (setq j (1+ j)) ) ) ) ) ) ) ) (if xp_oce (setvar "cmdecho" xp_oce)) ; restore old cmdecho value (setq *error* xp_err) ; restore old *error* handler (prin1) ) ;;; ;;; Sort out all of the entities which can be exploded from the selection ;;; set. Also ensure that block insertions have equal X, Y and Z scale factors. ;;; ;;; xp_sxe == DLine_Sort_Xplodable_Entities ;;; (defun xp_sxe (/ temp bad) (setq sslen (sslength ss) j 0 ss1 (ssadd)) (while (< j sslen) (setq temp (ssname ss j)) (setq j (1+ j)) (if (member (xp_val 0 temp nil) '("DIMENSION" "POLYLINE" "MLINE" "LWPOLYLINE" "3DSOLID" "REGION" "BODY")) (ssadd temp ss1) (progn ;; If it is an INSERT but not a MINSERT or XREF, add it. (if (member (xp_val 0 temp nil) '("INSERT")) (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "block" (cdr (assoc 2 (entget temp)))))))) ) ( (< 1 (cdr (assoc 70 (entget temp)))) ) ( (< 1 (cdr (assoc 71 (entget temp)))) ) ( T (ssadd temp ss1)) ) ) ) ) ) (setq sslen (sslength ss) bad (sslength ss1) ) (princ "\n ") (princ sslen) (princ " objets trouvés. ") (if (> (- sslen bad) 0) (progn (princ (- sslen bad)) (princ " non valable(s). ") ) ) ss1 ) ;;; ;;; Set the type of explode to do. ;;; ;;; xp_gxt == XPlode_Get_Xplode_Type ;;; (defun xp_gxt (/ temp) (initget "TOus COuleur CAlque TYpe Hérite Décompose") (setq temp (getkword "\n\n TOus/COuleur/CAlque/TYpe de ligne/Hérite du bloc parent/<Décompose>: ")) (if (or (= temp "") (null temp)) (setq temp "Décompose") ) temp ) ;;; ;;; Do the explosion of an entity. ;;; ;;; xp_xpe == XPlode_XPlode_Entity ;;; (defun xp_xpe (ent typ / ) (cond ((= typ "TOus") (if prmpt (progn (setq color (xp_scn)) (setq ltype (xp_slt)) (setq layer (xp_sla)) (setq prmpt nil) ) ) (xp_xfa) (if (or (= ans "Individuellement") (= j (1- sslen))) (progn (if (and (> sslen 1) (= ans "Globalement")) (princ "\n Objets ") (princ "\n Objet ") ) (princ (strcat "décomposé(s) avec la couleur " (if (= (type color) 'INT) (itoa color) (en_loc_type color)) ", " "le type de ligne " (en_loc_type ltype) ", " "et sur le calque " layer ".")) ) ) ) ((= typ "COuleur") (if prmpt (progn (setq color (xp_scn)) (setq ltype (getvar "celtype")) (setq layer (getvar "clayer")) (setq prmpt nil) ) ) (xp_xfa) (if (or (= ans "Individuellement") (= j (1- sslen))) (progn (if (and (> sslen 1) (= ans "Globalement")) (princ "\n Objets ") (princ "\n Objet ") ) (princ (strcat "décomposé(s) avec la couleur " (if (= (type color) 'INT) (itoa color) color) ".")) ) ) ) ((= typ "CAlque") (if prmpt (progn (setq color (getvar "cecolor")) (setq ltype (getvar "celtype")) (setq layer (xp_sla)) (setq prmpt nil) ) ) (xp_xfa) (if (or (= ans "Individuellement") (= j (1- sslen))) (progn (if (and (> sslen 1) (= ans "Globalement")) (princ "\n Objets ") (princ "\n Objet ") ) (princ (strcat "décomposé(s) sur le calque " layer ".")) ) ) ) ((= typ "TYpe") (if prmpt (progn (setq color (getvar "cecolor")) (setq ltype (xp_slt)) (setq layer (getvar "clayer")) (setq prmpt nil) ) ) (xp_xfa) (if (or (= ans "Individuellement") (= j (1- sslen))) (progn (if (and (> sslen 1) (= ans "Globalement")) (princ "\n Objets ") (princ "\n Objet ") ) ; localization fix (princ (strcat "décomposé(s) avec le type de ligne " (en_loc_type ltype) ".")) ) ) ) ((= typ "Hérite") (xp_iap ent) ) (T (command "_.EXPLODE" (xp_val -1 ent nil)) ; explode ) ) ) ;;; ;;; Force the color, linetype and layer attributes after exploding. ;;; ;;; xp_xea == XPlode_Xplode_Force_All ;;; (defun xp_xfa () (setq e0 (entlast)) (setq en (entnext e0)) (while (not (null en)) ; find the last entity (setq e0 en) (setq en (entnext e0)) ) (command "_.EXPLODE" (xp_val -1 ent nil)) ; explode (setq s0 (ssadd)) (while (entnext e0) (ssadd (setq e0 (entnext e0)) s0 ) ) (command "_.CHPROP" s0 "" ; change entities to the proper layer "_C" color ; color, and linetype, regardless "_LT" ltype ; of their extrusion direction "_LA" layer "" ) ) ;;; ;;; Inherit attributes (if BYBLOCK) from parent. ;;; ;;; xp_iap == XPlode_Inherit_Attributes_from_Parent ;;; (defun xp_iap (t1 / t1cl t1lt t1ly s0ly s0lt s0cl t0e) (setq yyy t1) (setq t0 (entlast)) (setq tn (entnext t0)) (while (not (null tn)) ; find the last entity (setq t0 tn) (setq tn (entnext t0)) ) (setq t1cl (xp_val 62 t1 nil)) ; record the attributes of the block (setq t1lt (xp_val 6 t1 nil)) (setq t1ly (xp_val 8 t1 nil)) (command "_.EXPLODE" (xp_val -1 ent nil)) ; explode (setq s0ly (ssadd)) ; create nil selection sets for layer (setq s0lt (ssadd)) ; linetype and color changes (setq s0cl (ssadd)) (setq t0 (entnext t0)) (while t0 ; can exploded entities (setq t0e (entget t0)) ; and build selection sets (if (= (xp_val 62 t0e T) "BYBLOCK") (ssadd t0 s0cl)) (if (= (xp_val 6 t0e T) "BYBLOCK") (ssadd t0 s0lt)) (if (= (xp_val 8 t0e T) "0") (ssadd t0 s0ly)) (setq t0 (entnext t0)) ) (if (> (sslength s0cl) 0) ; is selection set non-nil... (command "_.CHPROP" s0cl "" ; Change exploded entities with color "_CO" t1cl "") ; BYBLOCK to color of old block ) (if (> (sslength s0lt) 0) (command "_.CHPROP" s0lt "" ; Change exploded entities with linetype "_LT" t1lt "") ; BYBLOCK to linetype of old block ) (if (> (sslength s0ly) 0) (command "_.CHPROP" s0ly "" ; Change exploded entities with linetype "_LA" t1ly "") ; BYBLOCK to linetype of old block ) (if (or (= ans "Individuellement") (= j (1- sslen))) (progn (if (and (> sslen 1) (= ans "Globalement")) (princ "\n Objets ") (princ "\n Objet ") ) (princ "décomposé(s).") ) ) ) ;;; ;;; Set the color for the exploded entities. ;;; ;;; xp_scn == XPlode_Set_Color_Number ;;; (defun xp_scn () (setq arg 257) (while (> arg 256) (initget 2 "Rouge Jaune Vert Cyan BLEu Magenta BLAnc DUCalque DUBloc") (setq arg (getint (strcat "\n\n Nouvelle couleur pour les objets décomposés." "\n Rouge/Jaune/Vert/Cyan/BLEu/Magenta/BLAnc/DUCalque/DUBloc <" (if (= (type (getvar "cecolor")) 'INT) (itoa (getvar "cecolor")) (en_loc_type (getvar "cecolor")) ;display the translated term ) ">: "))) (cond ((= arg "DUBloc") (setq arg 0)) ((= arg "Rouge") (setq arg 1)) ((= arg "Jaune") (setq arg 2)) ((= arg "Vert") (setq arg 3)) ((= arg "Cyan") (setq arg 4)) ((= arg "BLEu") (setq arg 5)) ((= arg "Magenta") (setq arg 6)) ((= arg "BLAnc") (setq arg 7)) ((= arg "DUCalque")(setq arg 256)) (T (if (= (type arg) 'INT) (if (> arg 255) (progn (princ "\n Numéro de couleur en dehors de l'intervalle 1 - 255. ") (setq arg 257) ; kludge ) ) (setq arg (if (= (type (setq arg (getvar "cecolor"))) 'INT) (getvar "cecolor") (cond ((= arg "DUBloc") (setq arg 0)) ((= arg "DUCalque") (setq arg 256)) ) ) ) ) ) ) ) (cond ((= arg 0) (setq arg "DUBloc")) ((= arg 256) (setq arg "DUCalque")) ) arg ) ;;; ;;; Set the linetype from the loaded linetypes. ;;; ;;; xp_slt == XPlode_Set_Line_Type ;;; (defun xp_slt (/ temp) (while (null temp) (initget 1) (setq temp (strcase (getstring (strcat "\n Entrez le nom du nouveau type de ligne. <" (en_loc_type(getvar "celtype")) "> : ") ))) ; Strip the underscore away (if (equal "_" (substr temp 1 1)) (setq temp (substr temp 2))) (if (or (= temp "") (null temp)) (setq temp (en_loc_type (getvar "celtype"))) (if (not (or (tblsearch "ltype" (loc_en_type temp)) (= temp "DUBloc") (= temp "DUCalque") (= temp "CONTINUOUS") )) (progn (princ "\n Nom de type de ligne non valable.") (setq temp nil) ) ) ) ) temp ) ;;; ;;; Set a layer if it exists. ;;; ;;; xp_sla == XPlode_Set_LAyer ;;; (defun xp_sla (/ temp) (while (null temp) (initget 1) (setq temp (getstring (strcat "\n\n Décomposer sur quel calque? <" (getvar "clayer") ">: "))) (if (or (= temp "") (null temp)) (setq temp (getvar "clayer")) (if (not (tblsearch "layer" temp)) (progn (princ "\n Nom de calque incorrect.") (setq temp nil) ) ) ) ) temp ) ;; Localization fix ;; the function returns the translated and UPPERCASED name ;; (defun en_loc_type (type / trans) (setq trans type) (if (= (strcase trans) "BYLAYER") (setq trans (strcase "DUCalque")) (if (= (strcase trans) "BYBLOCK") (setq trans (strcase "DUBloc"))) ) trans ) ;; Localization fix ;; The function returns the english no localized term ;; (defun loc_en_type (type / trans ) (setq trans type) (if (= (strcase type) (strcase "DUCalque")) (setq trans "BYLAYER") (if (= (strcase type) (strcase "DUBloc")) (setq trans "BYBLOCK") ) ) trans ) ;;; --------------------------------------------------------------------------; (defun c:xp () (explode)) (defun c:xplode () (explode)) (princ "\n Taper Xplode ou XP.") (princ)

Bonjour, C'est un comportement normal avec des entités courbes. Tu peux améliorer ce comportement avec la commande RESVUE. L'autre solution (plus pénalisante dans de gros fichier) et de changer la variable WHIPARC. Voir l'aide pour info supplémentaire.

Pour en revenir à ton souci, il y a aussi simplement (je l'avais oubliée) la commande XPLODE en ligne de commande qui offre beaucoup d'options pour la commande DECOMPOS. C'est une fonction (C:XPLODE) intégrée dans Autocad, l'aide est accessible par F1.

Bonjour, Un début, peut être à creuser encore suivant les besoins ((lambda ( / e_mark js lay_ins e_last dxf_ent) (setq e_mark (entlast)) (setq js (ssget "_+.:E:S" '((0 . "INSERT")))) (cond (js (setq lay_ins (assoc 8 (entget (ssname js 0)))) (command "_.explode" (ssname js 0)) (setq e_last (entnext e_mark)) (while e_last (setq dxf_ent (entget e_last)) (entmod (subst lay_ins (assoc 8 dxf_ent) dxf_ent)) (setq e_last (entnext e_last)) ) ) ) ))

Avec PATIENCE (il est très sympa), j'ai commencé en 1986 sur un PC 286 avec le bouquin Autolisp d'Autodesk (Hé oui, la bibliothèque internet n'était pas vraiment disponible, en même temps je n'était pas distrait à surfer sur le net.)

Ta question est loin d'être con. Le raccord est possible sur un seul angle, mais la procédure et totalement différente. En effet dans ce que je t'ai proposé, _FILLET se contente du nom de l'entité à raccorder pour fonctionner. Si tu veux le faire sur un seul angle il va falloir lui simuler les points de sélection sur les cotés adjacents. Pour que cela fonctionne l'argument ne peut plus être le nom de l'entité mais une liste similaire à ce que pourrait retourner la fonction (entsel); c'est à dire le point de sélection et le nom de l'entité sous forme de liste. Les points de sélection sont important avec RACCORD, ils déterminent dans quel sens va se faire le raccord. Donc c'est faisable mais un peu plus compliqué, je te laisse cogiter un peu si tu veux faire cela: ;)

D' un dessin à autre je n'utilise jamais le "copier" (Ctrl+C) mais plutôt le "copier avec point de base" (Ctrl+Maj+C) et le "coller vers les coordonnées d'origine". Je n'ai jamais eu aucun problème, à croire que cela se comporte différemment du traditionnel Ctrl+C et Ctrl+V que l'on a avec les applications Windows.

Voici la partie qui t’intéresse: (setq old_fillet (getvar "FILLETRAD")) (setvar "FILLETRAD" EP2) (command "_.pline" P1 (list (+ (car P1) LA) (cadr P1)) (list (+ (car P1) LA) (+ (cadr P1) HT)) (list (car P1) (+ (cadr P1) HT)) "_close" ) (command "_.fillet" "_polyline" (entlast)) (setvar "FILLETRAD" EP) (command "_.pline" (list (+ (car P1) EP) (+ (cadr P1) EP)) (list (+ (car P1) (- LA EP)) (+ (cadr P1) EP)) (list (+ (car P1) (- LA EP)) (+ (cadr P1) (- HT EP))) (list (+ (car P1) EP) (+ (cadr P1) (- HT EP))) "_close" ) (command "_.fillet" "_polyline" (entlast)) (setvar "FILLETRAD" old_fillet)

RECTANG est en fait un programme externe en arx, donc illisible. Je suppose qu'il doit stocker la valeur dans une variable (mais laquelle!) car quand on annule (_undo) pour remonter avant la construction du rectangle, si on relance la commande rectang, la valeur du raccord est toujours la dernière entrée. Bizarrement il ne se sont pas servi de la variable standard FILLETRAD. Sans trouver le nom de leur variable, je ne vois pas de façon élégante pour réinitialiser le raccord. Tu pourrais utiliser la commande polyligne avec l'option clore, puis la commande raccord avec l'option polyligne qui produirait le même résultat et remettre la variable FILLETRAD à sa valeur avant utilisation.

Attention à la fonction (quote) abrégée avec ' Celle-ci n'évalue pas les arguments. Choisis simplement (cons) ou (list) pour construire tes points

Ils ne disparraissent pas, ils deviennent minuscule. Comme j'ai pu le dire c'est encore au stade embryonnaire, c'est plus pour voir si cela était faisable. Je l'ai testé en mètre, il faudrait je pense changer dans AutoTextScale.lsp (vers la fin): (* 0.01 txt_height) en (* 1.0 txt_height) Cette fonction converti tout les textes en texte de cotation. Cette fonction est à appliquer dans l'espace objet. L'autre fonction (Update_AutoScale) est à appliquer dans une fenêtre de l'espace papier pour mettre à jour la taille de tout les textes suivant le zoom en cours dans celle-ci. (comme peut faire pour les cotation l'option mettre à jour, d'aileurs cette commande fonctionnera aussi avec les textes convertis)

Bonjour, J'avais évoqué ce principe de texte dans ce sujet. Le code était embryonnaire, comme il n'y a eu aucune réaction d'intérêt, je n'ai pas continué le sujet... Depuis j'ai rectifié un peu le code, et fait un autre pour la mise à jour de ces faux textes (cotations déguisées) Je remets ces codes en pièces jointes puisque le sujet est évoqué à nouveaux. C'est certainement encore à creuser... AutoTextScale.lsp update autoscale.lsp

Quitte à surprendre, j'utilise (encore) un éditeur de texte basique (Notepad2 pour pas le citer: il indente les lignes pour la lisibilité et surtout il a l'avantage de mettre en évidence les parenthèses apparentées, ce qui est le plus pénible à contrôler en lisp et en plus il peut lire de très très gros fichier en DXF ASCII sans broncher) Après je fais beaucoup de copier-coller de bout de code que je possède déjà, on s'en aperçoit vite car on retrouve souvent les même noms de variable dans mes codes. Pendant la phase de construction du lisp, je ne déclare pas mes variables locale (sauf celle qui peuvent poser problème si elles ne sont pas réinitialisée entre chaque exécution, soit je la déclare soit je la remet à nil à un endroit approprié du code), comme cela je peux interroger mes variables après un bug pour repérer où cela coince (!nom_de_variable en ligne de commande pour avoir sa valeur). Dans les boucles un peu complexe il m'arrive aussi de faire temporairement un print d'une variable pour suivre en "live" son évolution. Voilà en gros ma manière de monter des lisp, mais il certain que la pratique joue dans la rapidité du montage... (moins d'erreur de syntaxe ou de mauvais arguments passés à une fonction, avec l'habitude on évite ces erreurs que l'on a souvent quand on débute) Je reste ancré sur mes veilles habitudes, j'ai bien essayé l'éditeur Vlisp mais je trouve que vais aussi vite sans, peut être parce que je ne le maîtrise pas assez bien...

J'ai édité le code précédent. Si ça te convient, tant mieux, car cela reste sommaire...

_AUDIT C'est la même commande... Répondre juste "Oui" pour corriger les erreurs décelées, autrement la commande CONTROLE ne fera rien du tout, à part te signaler que ton dessin contient des erreurs.

Bon, essayes ce code (qui est assez sommaire), je ne teste plus les pentes, mais plutôt l'orientement des barbules par rapport à l'axe principal de la voie. J'ai fais l'impasse sur les problèmes de fossé ou merlon, en dehors de ces cas, ça devrait fonctionner... (defun c:deb-remb ( / js dxf_cod js_ax ref_pente n ent_barb dxf_barb dxf_10 dxf_11 pt_proj) (princ "\nChoix d'une barbule modèle pour le filtrage: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "LINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) ) (princ "\nChoisir l'axe de la voie: ") (while (null (setq js_ax (ssget "_+.:E:S" (list '(0 . "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (cond (js (initget 5) (setq ref_pente (getreal "\nPente en % en dessous delaquelle la barbule est supprimée: ")) (repeat (setq n (sslength js)) (setq ent_barb (ssname js (setq n (1- n))) dxf_barb (entget ent_barb) dxf_10 (cdr (assoc 10 dxf_barb)) dxf_11 (cdr (assoc 11 dxf_barb)) pt_proj (vlax-curve-getClosestPointTo (vlax-ename->vla-object (ssname js_ax 0)) dxf_10) ) (if (> (distance (list (car dxf_10) (cadr dxf_10)) (list (car pt_proj) (cadr pt_proj))) (distance (list (car dxf_11) (cadr dxf_11)) (list (car pt_proj) (cadr pt_proj))) ) (if (assoc 62 dxf_barb) (entmod (subst (cons 62 1) (assoc 62 dxf_barb) dxf_barb)) (entmod (cons (cons 62 1) dxf_barb)) ) (if (assoc 62 dxf_barb) (entmod (subst (cons 62 3) (assoc 62 dxf_barb) dxf_barb)) (entmod (cons (cons 62 3) dxf_barb)) ) ) (if (< (abs (* (/ (- (caddr dxf_10) (caddr dxf_11)) (distance (list (car dxf_10) (cadr dxf_10)) (list (car dxf_11) (cadr dxf_11)))) 100)) ref_pente) (entdel ent_barb) ) ) ) ) (prin1) )

A priori, celui qui a adapté le code s'est appuyé sur le modèle standard des talus routier: a savoir 3 pour 2 en remblai soit une pente de 66.67% et 1 pour 1 en déblai soit 50% (talus en terre meuble), pour de la rocaille on a des pentes bien plus fortes. Donc en partant de ces règles standard, il a conçu un code pour fonctionner en règle générale sur des talus courants. Si on s'écarte de ces règles, le code ne vaut plus rien du tout... Donc trier des barbules avec des pentes faibles, comme tu désire le faire, est infaisable dans l'état du code et même avec un code mieux conçu, cela ne serait pas encore tip-top (barbules de merlon, de fossés difficile à interpreter) Mais rien n'est infaisable, mais le code à pondre serait assez conséquent avec beaucoup de tests à effectuer. Si tu sens d'attaque....