VDH-Bruno

Bonjour et merci de votre participation, C'est très bon, vous avez du l'écrire vite car je suis surpris que vous ayez préféré not = à /= ;) Cordialement,

Merci, on pourrait le croire, la vérité est que j'ai eu le besoin/envie, il y a peu de temps d'assimiler ces notions, donc par un heureux concours de circonstance j'avais déjà bien en tête une partie du sujet avant de commencer à répondre. Pour le reste ce n'est qu'une question d'entrainement, par habitude j'écris plus facilement mes fonctions de façon récursives, il est donc normal que je sois un peu plus à l'aise avec tous ce qui s'y rapporte (que ce soit le décryptage des fonctions récursives, ou des formules mathématiques établies sur un principe de récurrence). Amicalement Bruno

Bonjour, Je me suis aperçu que je n'avais pas vraiment répondu à la question du pourquoi d'une fonction en guise d'argument, je vais tenter une réponse au moyen d'une application pratique simple et un peu plus parlant que l'exemple du nombre d'or (et sa multitude de 1 en quotient et période): Pour l'exemple on va chercher avec cette fonction à approcher finement la valeur de la diagonale d'un cube unitaire (pour mémoire c'est la définition de la racine carré de 3 ) au moyen de sa fraction continue. Si je mesure cette longueur sur un cube 1m de côté, je vais trouver avec une précision de l'ordre du mm, une valeur de 1.732m pour la diagonale (difficile d'être plus précis avec mon décamètre :P ). Cette valeur est suffisante pour que si je développe ce nombre en fraction continue, j'obtienne le résultat suivant: [1 1 2 1 2 1 2 1 2 … ], à partir du numéro d'ordre 1, ma fraction est périodique (période=2, la séquence se répète tous les 2 chiffres). Ce qui implique que quand mon numéro d'ordre est impaire le quotient vaut 1, quand mon numéro d'ordre est paire le quotient vaut 2. Une fois ces éléments posés, il est facile de définir une fonction représentative en lisp au moyen de l'expession suivante: (lambda (i) (1+ (rem (1+ i) 2)) ) Puis de l'injecter dans la fonction cont-frac pour obtenir la valeur décimale de la racine de avec une précision d'ordre k (avec k=100 pour l'exemple), et ce à partir de la fraction continue du nombre. _$ (cont-frac (lambda (i) 1.0) (lambda (i) (1+ (rem (1+ i) 2)) ) 100) 0.732051 CQFD

:(rires forts): :(rires forts): :(rires forts):

Re, En tout cas ton intervention permet de voir regroupé sur un même fil, les contributeurs historique de ce forum que j'apprécie le plus tant sur le plan humain que intellectuel. (Ps: 2003 pour le trio (_zebulon, bonuscad, Patrick_35) et 2005 pour (gile), c'est beau! :) )

Salut, Plus simplement réponse #7: le 12h42 vient du forum en fait c'était cette nuit à 0h42 ou 24h42 réponse #10: 12h10, fin de matinée pendant la pause déjeuné :D

Re, Pour l'occasion 2 routines avec gcd, écrites par jeu il y a quelque temps, j'ai rarement eu l'occasion de m'en servir, la première est une généralisation de ce que tu as posté, la seconde est une tentative de recherche du pgcd sur une liste d'entier. ;;; FRAC-RED VDH-Bruno ;;; Arg: liste de 2 entiers (numerateur dénominateur) ;;; Retourne: les 2 entiers réduit au plus petit diviseur commun ;;; (frac-red '(10 5)) retourne (2 1) (defun frac-red (l) ((lambda (d) (list (/ (car l) d) (/ (cadr l) d))) (gcd (car l) (cadr l))) ) ;;; L->PGCD VDH-Bruno ;;; Retourne le plus grand diviseur appliqué à une liste de nombre entier ;;; ex : (l->pgcd '(6 12 18 24 30 36)) retourne 6 (defun l->pgcd (l) (if (apply '= l) (car l) (l->pgcd (mapcar 'gcd l (cdr l)))) ) ;| Optimisation possible (defun l->pgcd (l) (cond ((member 1 l) 1) ((apply '= l) (car l)) ((l->pgcd (mapcar 'gcd l (cdr l)))) ) ) ;| Sinon pour dans le cas qui nous préoccupe et comme tu l'as souligné le passage par une troncature de la partie décimal sera le plus souvent moins précis que de passer par le développement en fraction continue. A+

Slt Remplace: (setq i (fix x) n (list i 1) d (list 1 0) ) Par: (setq n (list 0 1) d (list 1 0) ) Merci au tien, et à tes nombreuses contributions de qualités sur ce forum. A+ (Ps: Historiquement et légitimement sur ce forum Bruno c'est toi ;) )

Bonsoir, Je venais faire un petit tour, pour donner la version itérative, je vois que (gile) m’as précédé, au passage bien vu le réel 1. dans la division, c’est une bonne précaution :) . Un petit rappel http://fr.wikipedia.org/wiki/Nombre_d'or (rubrique fraction continu). L’approche de sa valeur réel se fait au moyen de rapport sur 1. Si personnellement la fonction aurait pu être écrite autrement, l’énoncé du problème obligeait l’emploie de lambda (l'esprit étant de définir une fonction polyvalente). (cont-frac (lambda (i) 1.0) (lambda (i) 1.0) fonctionne à cause des expressions (n_i k) et (d_i k) que l'on retrouve dans le corps de la fonction, avec n_i et d_i ayant la valeur (lambda (i) 1.0) Donc quelque soit K on à ((lambda (i) 1.0) k),soit une fonction et un argument qui retourne 1. Maintenant si on passe le nombre 1 à la place d’une fonction, tu as l’erreur d’argument, il te faut une valeur fonctionnelle… Pour l'exemple l'approximation de la partie décimal de phi, sans les fonctions lambda (un cont-frac allégé): (defun phi-1 (k) (if (= 1 k) 1 (/ 1. (+ 1 (phi-1 (1- k)))) ) ) A + Bruno Ps : Merci pour le dmax, c’est un oubli pas une erreur de frappe , j’avais au départ commencé à coder n et d (numérateur et dénominateur), pour finalement codé p et q (produit et quotient) pour être dans les notations plus proche des formules.

Re, Code après factorisation... ;;; Conversion d'un nombre réel en fraction réduite par approximation ;;; fraction représenté sous la forme d'une liste de 2 nombres entiers ;;; (numérateur dénominateur) avec un dénominateur <= 255 ;;; ;;; Ex: (reel2frac pi) -> (355.0 113.0) ;;; (reel2frac 0.5) -> (1.0 2.0) ;;; (reel2frac 3) -> (3.0 1.0) (defun reel2frac (r / a qmax recurse) (defun recurse (d p q) (cond ((< qmax (car q)) (list (cadr p) (cadr q))) ((zerop d) (list (car p) (car q))) (T (setq r (/ 1.0 d) a (fix r) ) (recurse (- r a) (cons (+ (* a (car p)) (cadr p)) p) (cons (+ (* a (car q)) (cadr q)) q) ) ) ) ) (setq qmax 255 a (fix r) ) (mapcar 'float (recurse (- r a) (list a 1) (list 1 0))) ) Edit: modifié dmax et 1 par qmax et 1.0

Bonjour, Ci-dessous mon interprétation de ton énoncé, suis-je dans le vrai? Car personnellement je n'ai jamais créé de fichier de forme, tout au plus je me souviens en déjà utilisé à l'époque de la R11 ou R12. ;;; Conversion d'un nombre réel en fraction ;;; fraction retourné sous forme d'une liste de 2 nombres entiers ;;; (numérateur dénominateur) avec un dénominateur <= 255 ;;; ;;; Ex: (reel2frac pi) -> (355 113) ;;; (reel2frac 0.5) -> (1 2) ;;; (reel2frac 3) -> (3 1) (defun reel2frac (r / a d p q qmax frac recurse) (defun recurse (d p q) (cond ((< qmax (car q)) (list (cadr p) (cadr q))) ; sortie ((zerop d) (list (car p) (car q))) ; sortie (T (setq r (/ 1.0 d) a (fix r) d (- r a) p (cons (+ (* a (car p)) (cadr p)) p) q (cons (+ (* a (car q)) (cadr q)) q) ) (recurse d p q) ) ) ) ;; Initialisation (fraction ordre 0) (setq qmax 255 ; condition de sortie a (fix r) d (- r a) p (list a) q (list 1) ) (mapcar 'float (if (zerop d) (list (car p) (car q)) ;; Si partie décimal (fraction ordre 1) (setq r (/ 1.0 d) a (fix r) d (- r a) p (cons (1+ (* a (car p))) p) q (cons a q) frac (recurse d p q) ) ) ) ) Appliqué au nombre d'or (Phi) 1,618033.., une conversion de ce nombre irrationnel en une fraction réduite par approximation de 2 nombres entier (avec un dénomination <= 255), donnerait 377/233 soit 1.618025.. _$ (setq phi (/ (1+ (sqrt 5)) 2)) 1.61803 _$ (setq frac (reel2frac(/ (1+ (sqrt 5)) 2))) (377.0 233.0) _$ (apply '/ frac) 1.61803 A+ Bruno Edit: modifié dmax et 1 par qmax et 1.0

AutoCad effectue une sélection graphique seuls les objets à l'écran sont pris en compte. Une discussion similaire ou BonusCad, -Olivier- et moi même avions chercher une solution Lisp.. http://cadxp.com/topic/36031-selection-et-zoom/page__view__findpost__p__206998 Depuis j'ai un peu évolué sur la question mais je n'ai toujours pas pris le temps de revisiter le sujet pour voir si c'est perfectible. A+

Oui parler de gout résume toute la question, néanmoins j'aime bien les récursives, je pense que c'est une excellente gymnastique cérébrale tout à fait adapté au lisp. C'est vrai que je lui ai beaucoup emprunté, donc il me semble honnête de le citer lorsque j'utilise sur les forums des lignes de codes qu'il m'a inspiré, plutôt que de m'attribuer un mérite qui ne me reviens pas.. Amicalement, (Ps: Si dans ma programmation, je faisais plus de vlisp, ou sortais plus de l'application, tu serais évidemment cité d'avantage ;) )

Bonjour, Devancé par Patrick_35, mais bon ma réponse étant faites, je la livre tout de même.. J'ai dit éventuellement ce n'est pas une obligation, la factorisation consiste à repérer les portions de codes identiques, afin d'en faire des fonctions réutilisablent. Le code dans ma réponse 14 en est une illustration poussé à l'extrême, qui crée les fonctions *list type layoutlist, lorsque ces lignes de codes sont charger en mémoire. Pour l'exemple en regardant ton code on voit que 3 sections sont identiques ("Liste des calques" " Liste des Blocks" "Liste des SCU") et si on travaille avec les fonctions nouvellement créé (LAYERLIST) (BLOCKLIST) (UCSLIST) ce sont 4 sections de code identique avec la "Liste des presentations". Pour faire la factorisation de ton code, on extrait la partie semblable (write-line "______________________________________" fich_log) (write-line "Liste des presentations:" fich_log) (setq ListPres (layoutlist)) (while (/= ListPres nil) (write-line (car ListPres) fich_log) (setq ListPres (cdr ListPres)) ) On lui donne un nom de fonction et on remplace par des variables les éléments qui changent, ce qui donne ceci: ;; Ecrit dans un fichier une liste de chaines de caractères (defun write_list_str (texte liststr descfich) (write-line "______________________________________" descfich) (write-line texte descfich) (while (/= liststr nil) (write-line (car liststr) descfich) (setq liststr (cdr liststr)) ) ) Maintenant dans le corps du code principal, on rappel la nouvelle fonction en lui passant en arguments les variables, ce qui pourrait donner la réécrit suivante: (defun c:Balay (/ log_publication fich_log ListPres cal bl SCUS) ;;_____ Ouverture fichier LOG (setq log_publication (strcat "x:\\Log\\" (rtos (getvar "DATE")) ".log")) (setvar "luprec" 6) (setq fich_log (open log_publication "W")) ;;_____ Ecriture des valeurs de collection (write-line (getvar "dwgname") fich_log) (write-line (strcat "Date de création du fichier :" (def_date (getvar "tducreate"))) fich_log) (write-line (strcat "Date de Balayage fichier :" (def_date (getvar "DATE"))) fich_log) (write_list_str "Liste des presentations:" (layoutlist) fich_log) ;Liste des presentations (write_list_str "Liste des calques:" (layerlist) fich_log) ; Liste des calques (if (setq bl (blocklist)) ; Liste des Blocks (write_list_str "Liste des Blocks:" bl fich_log) ) (if (setq SCUS (ucslist)) ) ; Liste des SCU (write_list_str "Liste des SCU:" SCUS fich_log) ) (close fich_log) (command "START" log_publication) ) A+

Voici également ce que j'ai pondu sur ce thème, une version récursive une peut plus généraliste, récursive qui ne ce justifie pas forcément :(rires forts): ;;; TBLNEXTLIST VDH-Bruno ;;; Retourne la liste les noms de symboles correspondant aux appels successifs à la fonction tblnext ;;; Argument ;;; n -> Nom de table ("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT") ;;; f -> Si f (flag) est non nil, TBLLIST retourne tous les nom depuis la première entrée (defun tblnextlist (n f) (if (setq f (tblnext n f)) (cons (cdr (assoc 2 f)) (tblnextlist n nil)))) Ci dessous des fonctions plus spécifique qui retourne une liste sur le même modèle que la fonction (layoutlist), (code reprenant le modèle du code de "vue pavée" de (gile)) ;;; Ensemble de fonctions pour lister les noms de symboles des tables VDH-Bruno ;;; (LAYERLIST) -> Retourne la liste des Noms de calque ;;; (LTYPELIST) -> Retourne la liste des Noms de type de ligne ;;; (VIEWLIST) -> Retourne la liste des Noms de vue ;;; (STYLELIST) -> Retourne la liste des Noms de style de texte ;;; (BLOCKLIST) -> Retourne la liste des Noms de bloc ou nil ;;; (UCSLIST) -> Retourne la liste des Noms de SCU ou nil ;;; (APPIDLIST) -> Retourne la liste des Noms d'application ou nil ;;; (DIMSTYLELIST)-> Retourne la liste des Noms de style de cote ;;; (VPORTLIST) -> Retourne la liste des Noms de fenêtre ou nil (mapcar '(lambda (tbl) (eval (list 'defun (read (strcat tbl "list")) nil (list 'tblnextlist tbl T))) ) '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT") ) A+

Merci d'avoir partagé ton code, éventuellement pense à factoriser les portions de codes répétitives.

Re, L'erreur "non visible" que tu mentionnes avec la ligne de code que tu as posté, est fonction du nombre de calques (paire ou impaire), donc en sortie de boucle soit tu passais en argument à la fonction write-line un nom de calque ou bien nil, ce qui devait te renvoyé pour ce dernier un message d'erreur du type: ; erreur: type d'argument incorrect: stringp nil Sinon pour la "réponse pleine d'enseignement", Patrick_35 doit faire allusion à cette ligne de code (setq l (tblnext "layer" (not l))) juste après le while, une façon élégante de toujours pointer sur le premier calque, et de remettre la variable à nil en sortie de boucle. Cette expression est aussi un "grand classique", dont je ne suis pas l'auteur, je l'ai remarqué il me semble pour la première fois dans un code de (gile). Oui, et si ça continue tu va tout coder en récursif, même quand ce n'est pas justifié. :D A+

Ou bien en Vlisp avec une boucle vlax-for (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (princ (strcat "\n" (vla-get-Name l))) ) Ou comme ceci (vlax-map-collection (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) '(lambda (l) (princ (strcat "\n" (vla-get-Name l)))) ) Voilà pour les "grands" classiques A+

Re, Un exemple pour le principe (while (setq l (tblnext "layer" (not l))) (princ (strcat "\n" (cdr (assoc 2 l))))) A+

Bonjour, Oui comme cela tu obtiens un calque sur deux (2 tblnext dans chaque itération) Mémorise le tblnext de ton while pour la fonction assoc qui suit A+

Bonjour, Si tu ne veux pas jouer avec le SCU, dans ce cas une cotation alignée (COTALI ou _DIMALIGNED)sur la partie de segment droit, puis une cotation continue (COTCONT ou_DIMCONTINUE) pour la partie courbe gardera l'orientation pour ta cotation (avec des lignes d'attaches de longueurs différentes). A+

zebulon_ à la lecture du nota de wcmatch, et en croisant les info sur l'utilisation des caractères spéciaux dans les noms de calque décrit dans la fonction snvalid et souligné par BonusCAD. Ca donne envie d'être excessif dans le traitement et la désactivation des caractères spéciaux lorsque nécessaire avec un code du genre. ;; STR-REVQUOTE VDH-Bruno ;; Insère une apostrophe inversé devant tous les caractères de la chaines ;; ;; Exemple: ;; (str-revQuote "Calque1") => "`C`a`l`q`u`e`1" (defun str-revQuote (s) (if (eq s "") s (strcat "`" (substr s 1 1) (str-revQuote (substr s 2)))) ) A tester avec l'expression suivante: (sssetfirst nil (ssget "_X" (list (cons 8 (str-revQuote (cdr (assoc 8 (entget (car (entsel)))))))))) Merci de vos réflexions A+ (ps: Nous ne sommes hélas pas toujours les décideurs des noms de calques lorsque l'on a pas la main sur les projets)

Oui zebulon je me suis souvenu en lisant BonusCAD que cela venez de l'utilisation des caractères génériques, merci à toi d'avoir pris la peine de compléter. A+

wcmacth maintenant que tu l'écris ça me semble évident, merci Bonuscad, pris par l'urgence de la tache je n'ai pas percuté. Je vais sécuriser mes routines de sélections ce qui m'évitera à l'avenir de redéfinir mes noms de calques du projet en toutes hâtes. En attendant d'écrire une routine plus spécifique, je vais m'inspirer de l'expression suivante, repris de ton exemple: (sssetfirst nil (ssget "_X" (list (cons 8 (vl-string-subst "`[" "[" (cdr (assoc 8 (entget (car (entsel "Effectuer une sélection par calque => Choix d'un objet :"))))) ) ) ) ) ) Pour l'anecdote dans mon urgence j'ai intervertie le crochet gauche [ qui nécessite effectivement une désactivation, pour le crochet droit ] ce n'est pas nécessaire. A+ (Ps: Je rectifie le titre)

Merci du retour, si tu avais également testé celui de Patrick_35, tu te serais peut être aperçu, qu'il prenait en compte l'échelle d'insertion des blocs. Ci-dessous une version mise à jour du code au cas ou l'échelle d'insertion aurait son importance. (defun c:insDesc2 (/ ss i e valDesc2 e-dxf) ;; GetAttribs (gile) ;; Retourne une liste de paire pointées (TAG . Value) par attribut contenus dans le bloc ;; ;; Argument ;; ent : le nom d'entité (ENAME) de la référence de bloc (defun GetAttribs (ent / elst lst) (setq ent (entnext ent)) (while (= "ATTRIB" (cdr (assoc 0 (setq elst (entget ent))))) (setq lst (cons (cons (cdr (assoc 2 elst)) (cdr (assoc 1 elst))) lst) ent (entnext ent) ) ) (reverse lst) ) ;; Programme principal (setq ss (ssget "_X" '((0 . "INSERT") (2 . "SRVPNO2")))) (repeat (setq i (if ss (sslength ss) 0 ) ) (setq e (ssname ss (setq i (1- i))) valDesc2 (cdr (assoc "DESC2" (getattribs e))) e-dxf (entget e) ) (if (and valDesc2 (tblsearch "block" valDesc2)) (entmakex (list '(0 . "INSERT") (cons 2 valDesc2) (cons 10 (cdr (assoc 10 e-dxf))) (cons 41 (cdr (assoc 41 e-dxf))) (cons 42 (cdr (assoc 42 e-dxf))) (cons 43 (cdr (assoc 43 e-dxf))) (cons 50 (cdr (assoc 50 e-dxf))) (cons 210 (cdr (assoc 210 e-dxf))) ) ) ) ) (princ) ) A+