Rechercher dans la communauté
Affichage des résultats pour « challenge » dans sujets.
-
Je pense que l'immense majorité des utilisateurs (moi compris) préfèreront Ppl, je m'étais laissé obnubilé par les problèmes soulevés dans ce challenge...
-
Salut lecrabe, C'est voulu, la question s'était posée dans le challenge 12. Supprimer des sommets alignés mais non interposés peut changer l'allure de la polyligne : http://img141.imageshack.us/img141/9606/clean3fw1.png Salut Matt666, Je pense que c'est la même logique, tu utilises aussi betweenp (dans remove-align), mais ta routine ne tient pas compte des épaisseurs et ne traite pas les points situés sur un même arc (cas certainement extrèmement rare).
-
J'avais fait un LISP, Clean_poly, qui supprimait tout les sommets superposés dans tout type de polyligne. Celui-ci ne traite que les polyligne 'optimisées' (lwpolyline) mais supprime aussi tous les sommets alignés (ou sur le même arc) à condition qu'ils ne marquent pas une rupture de largeur (voir image). C'est un peu une application concrète du Challenge 12 http://img50.imageshack.us/img50/4734/clean2ir7.png Nouvelle version : 2 commandes Cpl et Ppl (voir plus bas) ;; CPL Fonction d'appel (defun c:cpl (/ ss n) (vl-load-com) (princ "\nSélectionnez les polylignes à traiter ou [b]: " ) (or (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq ss (ssget "_X" '((0 . "LWPOLYLINE")))) ) (if ss (progn (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setq n -1) (while (setq pl (ssname ss (setq n (1+ n)))) (CleanPline pl nil) ) (princ (strcat "\n\t" (itoa n) " polylignes traitées.")) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ) (princ "\nAucune polyligne sélectionnée.") ) (princ) ) ;; PPL Fonction d'appel (defun c:ppl (/ ss n) (vl-load-com) (princ "\nSélectionnez les polylignes à traiter ou [b]: " ) (or (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq ss (ssget "_X" '((0 . "LWPOLYLINE")))) ) (if ss (progn (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (setq n -1) (while (setq pl (ssname ss (setq n (1+ n)))) (CleanPline pl T) ) (princ (strcat "\n\t" (itoa n) " polylignes traitées.")) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) ) (princ "\nAucune polyligne sélectionnée.") ) (princ) ) ;; CleanPline (gile) 13/11/2007 ;; Supprime tous les sommets superflus (alignés ou superposés) d'une polyligne ;; Conserve les arcs et largeurs. ;; ;; Arguments ;; pl : la polyligne à traiter (ename) ;; tt : T ou nil ;; - T supprime tous les points alignés ou sur le même arc ;; - nil conserve les sommets qui reviennent sur le trajet de la polyligne (defun CleanPline (pl tt / regular-width elst closed old-p old-b old-sw old-ew new-p new-b new-sw new-ew b1 b2 ) (defun regular-width (p1 p2 p3 ws1 we1 ws2 we2 / delta norm) (setq delta (- we2 ws1) ) (and (= we1 ws2) (equal (/ (- (vlax-curve-getDistAtPoint pl (trans p2 pl 0)) (vlax-curve-getDistAtPoint pl (trans p1 pl 0)) ) (- (vlax-curve-getDistAtPoint pl (trans p3 pl 0)) (vlax-curve-getDistAtPoint pl (trans p1 pl 0)) ) ) (/ (- we1 (- we2 delta)) delta) 0.01 ) ) ) (setq elst (entget pl)) (and (= 1 (logand 1 (cdr (assoc 70 elst)))) (setq closed T)) (setq old-p (vl-remove-if-not (function (lambda (x) (= (car x) 10))) elst ) old-sw (vl-remove-if-not (function (lambda (x) (= (car x) 40))) elst ) old-ew (vl-remove-if-not (function (lambda (x) (= (car x) 41))) elst ) old-b (vl-remove-if-not (function (lambda (x) (= (car x) 42))) elst ) elst (vl-remove-if (function (lambda (x) (member (car x) '(10 40 41 42)))) elst ) ) (and closed (setq old-p (append old-p (list (car old-p))))) (while (cddr old-p) (if (or (= (cdar old-sw) (cdar old-ew) (cdadr old-sw) (cdadr old-sw) ) (regular-width (cdar old-p) (cdadr old-p) (cdaddr old-p) (cdar old-sw) (cdar old-ew) (cdadr old-sw) (cdadr old-ew) ) ) (if (and (zerop (cdar old-b)) (zerop (cdadr old-b)) ) (if (if tt (null (inters (cdar old-p) (cdaddr old-p) (cdar old-p) (cdadr old-p) ) ) (betweenp (cdar old-p) (cdaddr old-p) (cdadr old-p)) ) (setq old-p (cons (car old-p) (cddr old-p)) old-b (cons (car old-b) (cddr old-b)) old-sw (cons (car old-sw) (cddr old-sw)) old-ew (cons (cadr old-ew) (cddr old-ew)) ) (setq new-p (cons (car old-p) new-p) new-b (cons (car old-b) new-b) new-sw (cons (car old-sw) new-sw) new-ew (cons (car old-ew) new-ew) old-p (cdr old-p) old-b (cdr old-b) old-sw (cdr old-sw) old-ew (cdr old-ew) ) ) (if (and (/= 0.0 (cdar old-b)) (/= 0.0 (cdadr old-b)) (equal (caddr (setq b1 (BulgeData (cdar old-b) (cdar old-p) (cdadr old-p)) ) ) (caddr (setq b2 (BulgeData (cdadr old-b) (cdadr old-p) (cdaddr old-p)) ) ) 1e-4 ) (or tt (or (and ( (and ( ) ) ) (setq old-p (cons (car old-p) (cddr old-p)) old-b (cons (cons 42 (tan (/ (+ (car b1) (car b2)) 4.0))) (cddr old-b) ) old-sw (cons (car old-sw) (cddr old-sw)) old-ew (cons (cadr old-ew) (cddr old-ew)) ) (setq new-p (cons (car old-p) new-p) new-b (cons (car old-b) new-b) new-sw (cons (car old-sw) new-sw) new-ew (cons (car old-ew) new-ew) old-p (cdr old-p) old-b (cdr old-b) old-sw (cdr old-sw) old-ew (cdr old-ew) ) ) ) (setq new-p (cons (car old-p) new-p) new-b (cons (car old-b) new-b) new-sw (cons (car old-sw) new-sw) new-ew (cons (car old-ew) new-ew) old-p (cdr old-p) old-b (cdr old-b) old-sw (cdr old-sw) old-ew (cdr old-ew) ) ) ) (if closed (setq new-p (reverse (append (cdr (reverse old-p)) new-p))) (setq new-p (append (reverse new-p) old-p)) ) (setq new-b (append (reverse new-b) old-b) new-sw (append (reverse new-sw) old-sw) new-ew (append (reverse new-ew) old-ew) ) (entmod (append elst (apply 'append (apply 'mapcar (cons 'list (list new-p new-sw new-ew new-b)) ) ) ) ) ) ;;; VEC1 Retourne le vecteur normé (une unité) de direction p1 p2 (defun vec1 (p1 p2 / d) (if (not (zerop (setq d (distance p1 p2)))) (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2) ) ) ;; BETWEENP Evalue si pt est entre p1 et p2 (defun betweenp (p1 p2 pt) (or (equal p1 pt 1e-9) (equal p2 pt 1e-9) (equal (vec1 p1 pt) (vec1 pt p2) 1e-9) ) ) ;; BulgeData Retourne les données d'un polyarc (angle rayon centre) (defun BulgeData (bu p1 p2 / ang rad) (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2) (* 2 (sin ang)) ) cen (polar p1 (+ (angle p1 p2) (- (/ pi 2) ang)) rad ) ) (list (* ang 2.0) rad cen) ) ;; TAN Retourne la tangente de l'angle (defun tan (ang) (/ (sin ang) (cos ang)) ) [Edité le 12/11/2007 par (gile)] [Edité le 13/11/2007 par (gile)]
-
FACE 3D à projeter sur le plan (z=0)
lovecraft a répondu à un(e) sujet de thom.noisemap dans AutoCAD 2006
AH je viens de trouver une nouveau challenge par rapport a ce sujet. Le but serait de mettre tous les elements 3D à Zéro. (ligne 3D, Face3D, ligne, elevation de polyligne etc....). Mais afin de garder les elements d'origine du dessin. c'est de copier cette 2D dans un nouveau calque. Exemple: les faces 3D du calque MNT_PROJET deviendront des face3D à Zéro dans le calque MNT_PROJET_2D. Voilà bon devellopement à tous. Moi je commence de suite ;) -
Salut! J'espère que vous avez passez un bon week-end ? (pour les chanceux comme moi qui ont eu 4j) ca fait du bien :). J'ai aussi demandé à mon patron s'il voulait bien m'augmenter de 140%, réponse: demander tu peux. Si c'est accepter, faut voir ;). Sinon j'ai une autre proposition, plutot que de travail + pour gagner +, pourquoi ne pas faire: travailler - pour gagner autant. Je me verrai bien travailler du lundi au mercredi comma la semaine dernière, pour le même salaire (sachant que je fait presque 24h/35h sur ces 3 premiers jours). Bon, revenons sur le sujet du challenge. Vu que le code devient long, j'ai mis en ligne sur mes pages perso les trois lisps: - random - gestion_mots pour chargement/sauvegarde des fichiers de mots et recherches - challenge13 qui contient genere, combi et plus_de_mots qui demande à l'utilisateur de trouver un maximum de mots. http:// http://bseb67.free.fr/cadxp/challenge/13/ La seule chose que je ne sais pas faire, et je pense que lisp ne permette de ne pas le faire, c'est pour le "timer", je donne 3minutes pour trouver les mots, je ne sais pas sortir au bout de ces 3 minutes. La parade utilisée est de tester lors de la saisie du mot si le temps n'est pas dépassé. MAintenant il reste à faire une petite interface, soit une dcl soit un dessin sur le fichier autocad ouvert.
-
Re, Depuis le début du challenge 13 j'avais le sentiment qu'on pouvait trouver un algorythme plus efficace que celui duquel je n'arrivais pas à me sortir. Je pense avoir trouver quelque chose de beaucoup mieux : la liste des combinaisons est constituée directement en évitant les doublons. Ça prend environ 5 secondes pour (combinaisons '(a b c d e f g h i j k l m n)) sur mon poste (16383 éléments). (defun combinaisons (lst / subr first tmp1 tmp2 tmp3 ret) (defun subr (l1 l2) (if l2 (cons (append l1 (list (car l2))) (subr l1 (cdr l2)) ) ) ) (while lst (setq first (list (car lst)) tmp1 (subr first (cdr lst)) tmp2 (cons first tmp1) ) (while tmp1 (setq tmp3 (subr (car tmp1) (cdr (member (last (car tmp1)) lst))) tmp1 (cdr (append tmp1 tmp3)) tmp2 (append tmp2 tmp3) ) ) (setq ret (append ret tmp2) lst (cdr lst) ) ) ret ) (combinaisons '(A B C D)) ((A) (A B) (A C) (A D) (A B C) (A B D) (A C D) (A B C D) (B) (B C) (B D) (B C D) © (C D) (D) ) [Edité le 2/11/2007 par (gile)]
-
Merci encore, (gile) ! (je n'avais plus fait attention au challenge que tu cites, désolé)
-
Re, le challenge demandait de trier les combinaisons possibles de listes de lettres, si on veut quelque chose de plus général et sans tri : ;; REMOVE_IND ;; Retourne la liste privée de l'élément à l'indice spécifié ;; (premier élément = 0) (defun remove_ind (lst ind / tmp) (if (or (zerop ind) (null lst)) (cdr lst) (cons (car lst) (remove_ind (cdr lst) (1- ind))) ) ) ;; COMBI-1 ;; Retourne toutes les combinaisons possibles avec 1 élément en moins ;; (combi-1 '("a" "b" "c")) -> (("a" "b") ("a" "c") ("b" "c")) (defun combi-1 (lst / n ret) (setq n -1) (repeat (length lst) (setq ret (cons (remove_ind lst (setq n (1+ n))) ret)) ) ) ;; COMBINAISONS ;; retourne la liste de toutes les combinaisons possibles (defun combinaisons (lst / first ret) (setq lst (list lst)) (while ( (if (member first ret) (setq lst (cdr lst)) (if (= 1 (length first)) (setq ret (cons first ret) lst (cdr lst) ) (setq ret (cons first ret) lst (append (cdr lst) (combi-1 first)) ) ) ) ) ret ) [Edité le 29/10/2007 par (gile)]
-
Salut, Regarde la routine combi dans ce challenge
-
Bonjour , Voici le challenge auquel je suis confronté : --Je souhaite copier des repertoires contenat des dessins en dxf 2000 vers un repertoire avec ces dessins en dwg2004 avec au passage la creation de la miniatures .... --Pour la cretion de la miniatures , il suufit d'ouvrir chaque dessin dans autocad et de l'enregistrer à nouveau ( en ayant bien configurer autoacd )) Merci pour vos pistes , acr je ne sais pas trop si je pars sur du vba ou un cript ou un lisp... A bientot ..
-
Salut Ce n'est pas la mauvaise volonté, mais en ce moment, je n'ai absolument pas le temps pour me plonger dans ce type de challenge Quand ce sera plus calme ;) @+
-
:o :o :casstet: :P C'est n'importe quoi! Donc je vais quand même devoir changer mon code :( ! Sinon il me reste à faire une fonction de trie. J'ai déjà fait le tri à bulles, mais c'est l'un des plus lent. Sinon, free ca coince encore. j'ai donc mis en partage un fichier zip: http:// http://dl.free.fr/c3gj6Kooc/bd_mots_bseb67_challenge13.zip Le zip est protégé nom:bseb67 mdp: cadxp. C'est un fichier contenant 6 fichiers txt: MOT3L.txt, MOT4L.txt, MOT5L.txt, MOT6L.txt MOT7L.txt, MOT8L.txt et MOT9L.txt. Deuxième partie: 1) il faut charger chaque fichier sous forme d'une liste par fichier. Les mots ne sont pas accentués. => les fichiers contiennent plusieurs lignes. Pour les mots de 3 lettres (MOT3L.txt) les premières lignes sont celles-ci: AAA/ AAB/ AAC/ AAD/ada/ Donc en majuscule on a une suite de lettres triées alphabétiquement. Puis un "/" pour séparer les mots. Ensuite en minuscule la liste des mots possibles pour cette suite. (Voilà le pourquoi de genere et de combi :) ). Pour ce mini exemple on aura alors une variable (MOT3L par exemple) qui vaudra: '(("AAA") ("AAB") ("AAC") ("AAD" "ada")) 2) faire une fonction qui renvoie tous les mots possibles avec la liste créer par genere. exemple: (setq lst (genere 4)) => '("A" "A" "D" "A") (setq lst_combi (combi lst 3)) => '(("A" "A" "A" "D") ("A" "A" "A") ("A" "A" "D")) (tous_les_mots lst_combi) => '("ada") 3) faire un petit main qui demande à l'utilisateur un nombre de lettre (utilisé pour genere) et on lancera combi avec 3 comme deuxième paramètre. Il faudra alors lui demander de taper tous les mots qu'il connait et de donner un score. 4) Il sera possible, vu que je pense avoir oublier des mots, de créer un lisp pour ajouter de nouveau mot et sauvegarder les données dans les fichiers. 5) Une variante possible: le mot le plus long (vu que c'est 9 lettres pour le jeu) 6) Autre variante : le jeu du pendu. 7) Pour finir de faire une extension graphique : dessin dans autocad d'un tableau contenant les mots saisie et s'ils sont validés + ceux non trouvés. Voilà, j'espère enfin voir quelqu'un de plus que Gile, :( , ce n'est pas que je ne t'aimes pas Gile, mais à part nous deux il n'y a personne pour mon challenge. :( :( :( [Edité le 23/10/2007 par bseb67]
-
:o :o :casstet: :P C'est n'importe quoi! Donc je vais quand même devoir changer mon code :( ! Sinon il me reste à faire une fonction de trie. J'ai déjà fait le tri à bulles, mais c'est l'un des plus lent. Sinon, free ca coince encore. j'ai donc mis en partage un fichier zip: http:// http://dl.free.fr/bW9vkmWuu/bd_mots_challenge13.zip Le zip est protégé nom:bseb67 mdp: cadxp. C'est un fichier contenant 6 fichiers txt: MOT3L.txt, MOT4L.txt, MOT5L.txt, MOT6L.txt MOT7L.txt, MOT8L.txt et MOT9L.txt. Deuxième partie: 1) il faut charger chaque fichier sous forme d'une liste par fichier. Les mots ne sont pas accentués. => les fichiers contiennent plusieurs lignes. Pour les mots de 3 lettres (MOT3L.txt) les premières lignes sont celles-ci: AAA/ AAB/ AAC/ AAD/ada/ Donc en majuscule on a une suite de lettres triées alphabétiquement. Puis un "/" pour séparer les mots. Ensuite en minuscule la liste des mots possibles pour cette suite. (Voilà le pourquoi de genere et de combi :) ). Pour ce mini exemple on aura alors une variable (MOT3L par exemple) qui vaudra: '(("AAA") ("AAB") ("AAC") ("AAD" "ada")) 2) faire une fonction qui renvoie tous les mots possibles avec la liste créer par genere. exemple: (setq lst (genere 4)) => '("A" "A" "D" "A") (setq lst_combi (combi lst 3)) => '(("A" "A" "A" "D") ("A" "A" "A") ("A" "A" "D")) (tous_les_mots lst_combi) => '("ada") 3) faire un petit main qui demande à l'utilisateur un nombre de lettre (utilisé pour genere) et on lancera combi avec 3 comme deuxième paramètre. Il faudra alors lui demander de taper tous les mots qu'il connait et de donner un score. 4) Il sera possible, vu que je pense avoir oublier des mots, de créer un lisp pour ajouter de nouveau mot et sauvegarder les données dans les fichiers. 5) Une variante possible: le mot le plus long (vu que c'est 9 lettres pour le jeu) 6) Autre variante : le jeu du pendu. 7) Pour finir de faire une extension graphique : dessin dans autocad d'un tableau contenant les mots saisie et s'ils sont validés + ceux non trouvés. Voilà, j'espère enfin voir quelqu'un de plus que Gile, :( , ce n'est pas que je ne t'aimes pas Gile, mais à part nous deux il n'y a personne pour mon challenge. :( :( :(
-
Bon j'avais pas vue passer le poste mais si tu as d'autre challenge dans le meme genre alors, je veux bien essayer de participer. @+ MDSV31 PS: code bien documenté, jamais vue avant.
-
Salut (gile). Oui, c'est vrai qu'il n'y a pas grand monde pour mon challenge :( . Pour la suite, j'attends l'activation de mes pages persos chez free pour donner les fichiers nécessaires à la suite. J'ai déjà fait une partie de la seconde partie (et oui je triche ;), vu que je connais le sujet). Je vais me mettre sur la première partie cette aprem. En tout cas merci pour la fonction rng. Au départ je pensais aussi faire simplement un random entre 1 et 26, mais j'ai choisis de mettre la fréquence des lettres en jeu. (setq FREQ_LETTRES '(("A" 00.00 08.12 8.12) ("B" 08.12 08.94 00.82) ("C" 08.94 12.32 3.38) ("D" 12.32 16.61 4.29) ("E" 16.61 34.30 17.69) ("F" 34.30 35.43 1.13) ("G" 35.43 36.62 1.19) ("H" 36.62 37.36 00.74) ("I" 37.36 44.60 7.24) ("J" 44.60 44.78 0.18) ("K" 44.78 44.80 00.02) ("L" 44.80 50.79 5.99) ("M" 50.79 53.08 2.29) ("N" 53.08 60.76 07.68) ("O" 60.76 65.96 5.20) ("P" 65.96 68.89 2.93) ("Q" 68.89 69.73 00.84) ("R" 69.73 76.17 6.44) ("S" 76.17 85.05 8.88) ("T" 85.05 92.50 07.45) ("U" 92.50 97.74 5.24) ("V" 97.74 99.02 1.28) ("W" 99.02 99.08 00.06) ("X" 99.08 99.62 0.54) ("Y" 99.62 99.88 0.26) ("Z" 99.88 100.00 0.12) ) ) Les quadruplets sont: lettre - % départ - % arrivée - fréquence) Et donc j'obtiens alors: ;--------------------------------; ; nom: random_char ; ; role: retourne un caractère ; ; en utilisant la fréquence; ; param: aucun ; ; retour: un caractère ; ; date: 17/10/2007 ; ; BLAES Sébastien ; ;--------------------------------; (defun random_char( / res cpt find) (setq res (* (rng) 100.0) cpt 0 find nil) ; on parcourt les fréquences, pour trouver la lettre (while (= find nil) (if (and (>= (cadr (nth cpt FREQ_LETTRES)) res) (<= res (caddr (nth cpt FREQ_LETTRES)))) (setq res (car (nth cpt FREQ_LETTRES)) find t) ) ; if ; on incrémente cpt (setq cpt (1+ cpt)) ) ; while res ) ; random_char ;-----------------------------; ; nom: genere ; ; role: retourne nb caractères; ; sous forme d'une liste; ; param: nb => entier ; ; retour: entier ; ; date: 17/10/2007 ; ; BLAES Sébastien ; ;-----------------------------; (defun genere( nb / cpt res) (setq cpt 0 res '()) (while (< cpt nb) (setq res (cons (random_char) res) cpt (1+ cpt)) ) ; while res ) ; genere Il me reste plus qu'a faire combi :). A plus!
-
Salut, Ce fut l'objet d'un "challenge" ici.
-
Un exemple d'utilisation du challenge !! ;;;xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ;;; Crée des copies Incrémentées du texte sélectionné (defun c:cpi ( / ent ntxt inc pt val lst ntxt) (setq cmdecho (getvar "cmdecho") m:err *error* *error* erreur ) (setvar "cmdecho" 0) (command "_undo" "D") (if (eq (ssget "i") nil) (setq ent (car (entsel "\nSélectionner texte à incrémenter :"))) (if (> (sslength (ssget "i")) 1) (setq ent (car (entsel "\nSélectionner texte à incrémenter :"))) (setq ent (ssname (ssget "i") 0)) ) ) (cond ((and ent (member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT")) (setq inc (read2 (getstring "\nIncrément : "))) (setq pdst (getpoint (cdr (assoc 10 (entget ent)))"\nPoint d'insertion :")) ) (while pdst (if (or (eq pdst "I") (eq pdst "i")) (progn (while (not (setq inc (read2 (getstring "\nNouvel incrément : "))))) (setq pdst (getpoint (cdr (assoc 10 (entget ent)))"\nNouveau point d'insertion :")) ) ) (setq val (cdr (assoc 1 (entget ent)))) (if (and (eq (substr val 1 1) "0") (> (strlen val) 2) ) (setq lst (cons 0 (sep val))) (setq lst (sep val)) ) (cond ((and (eq 1 (length lst)) (or (eq (type (car lst)) 'REAL) (eq (type (car lst)) 'INT) ) ) (setq ntxt (+ inc (car lst))) (if (and (eq (substr val 1 1) "0") (< ntxt 10) (eq (type (car lst)) 'INT) (/= (substr (princ-to-string ntxt) 1 1) "0") ) (setq ntxt (strcat "0" (princ-to-string ntxt))) (setq ntxt (princ-to-string ntxt)) ) ) ((< 1 (length lst)) (setq ntxt "") (foreach pt lst (if (/= 0.00 pt) (if (or (eq (type pt) 'INT) (eq (type pt) 'REAL) ) (setq ntxt (strcat ntxt (princ-to-string (+ inc pt)) )) (setq ntxt (strcat ntxt pt)) ) (if (or (eq (type pt) 'INT) (eq (type pt) 'REAL) ) (setq ntxt (strcat ntxt "0")) ) ) ) ) ) (if ntxt (entmake (list (cons 0 (cdr (assoc 0 (entget ent)))) (cons 10 pdst) (cons 1 ntxt) (cons 8 (cdr (assoc 8 (entget ent)))) (cons 6 (cdr (assoc 6 (entget ent)))) (cons 62 (cdr (assoc 62 (entget ent)))) (cons 71 (cdr (assoc 71 (entget ent)))) (cons 72 (cdr (assoc 72 (entget ent)))) (cons 7 (cdr (assoc 7 (entget ent)))) (cons 40 (cdr (assoc 40 (entget ent)))) )) (princ "\nTexte créé.") ) (initget "I") (setq ent (entlast) pdst (getpoint (cdr (assoc 10 (entget ent)))"\nNouveau point d'insertion [incrément] :") ) ) ) ) (command "_undo" "F") (setq *error* m:err m:err nil) (setvar "cmdecho" cmdecho) (princ) ) Avec sep = routine de ElpanovEvgeniy ou de gile Et read2 c'est ça ;;; Read en prenant en compte le point (defun read2 (str) (if (/= str ".") (read str) str ) ) Voilà ! A bientot. matt EDIT : PS Faut pas oublier les VL avant princ-to-string, et tout le bazaar... J'ai pas testé sur autoCAD ! EDIT2 : Bout de code en trop déclé par ElpanovEvgeniy [Edité le 19/10/2007 par Matt666] [Edité le 19/10/2007 par Matt666]
-
Bonjour à toutes et tous, Voilà ou j'en suis à ce jour : Avant : ; ******************************************************************* ; barre droitenom.LSP ; ;(modes '("CMDECHO" "ATTDIA" "ATTREQ" "GRIDMODE" "UCSFOLLOW")) ;(setvar "cmdecho" 0) ; turn cmdecho off ;(setvar "attdia" 0) ; turn attdia off ;(setvar "attreq" 1) ; turn attreq on ;(setvar "gridmode" 0) ; turn gridmode off ;(setvar "ucsfollow" 0) ; turn ucsfollow off (defun C:barredroitenom () (setq p3 (getpoint "\pt d'insertion nomenclature : ")) (command "_.insert"" nom barre droite " p3 1 1 "") (command "_.explode" "d") (setq p2 (getpoint "\pt d'insertion bloc : ")) (command "_.insert"" ha barre droite " p2 1 1"") (setq p4 (getpoint "\pt d'insertion repere acier : ")) (command "_.insert"" rep acier barre " p4 1 1 "") (setq p5 (getpoint "\pt intermediere de ligne de repere : ")) (setq p6 (getpoint "\pt insertion numero de repere : ")) (command "_.layer" bac ferraillage repere plan "") (command "_.pline" p4 p5 p6 "") (command "_.insert"" numerorepere " p6 1 1 "") (command "_.explode" "d")) Aprés : ; ******************************************************************* ; barre droitenom.LSP ; ;(modes '("CMDECHO" "ATTDIA" "ATTREQ" "GRIDMODE" "UCSFOLLOW")) ;(setvar "cmdecho" 0) ; turn cmdecho off ;(setvar "attdia" 0) ; turn attdia off ;(setvar "attreq" 1) ; turn attreq on ;(setvar "gridmode" 0) ; turn gridmode off ;(setvar "ucsfollow" 0) ; turn ucsfollow off (defun C:bdh () (setq p3 (getpoint "\pt d'insertion nomenclature : ")) (command "_.insert"" nom barre droite " p3 1 1 "") (command "_.explode" "d") (setq p2 (getpoint "\pt d'insertion bloc : ")) (command "_.insert"" ha barre droite " p2 1 1"") (setq p4 (getpoint "\pt d'insertion repere acier : ")) (command "_.insert"" rep acier barre " p4 1 1 "") (setq p5 (getpoint "\pt intermediere de ligne de repere : ")) (command "_.pline" p4 p5 "") (command "CHANGER" "d" "" "p" "ca" "BAC FERRAILLAGE REPERE PLAN" "") (setq p6 (getpoint "\pt insertion numero de repere : ")) (command "_.pline" p5 p6 "") (command "CHANGER" "d" "" "p" "ca" "BAC FERRAILLAGE REPERE PLAN" "") (command "_.insert"" numerorepere " p6 1 1 "") (command "_.explode" "d")) Ce qui est sûr, c'est que cela marche comme je voulais, mais de là à dire que c'est la bonne écriture,.... Merci d'avance de vos remarques et suggestions (j'en ai encore une quinzaine comme ça et je reviendrai vous voir pour savoir comment les ranger toutes dans un seul fichier Lisp,... Tiens, cela pourrait être un challenge débutant, non???). (gile) & Patrick_35, je n'ai pas tenu compte de vos conseils afin d'avoir votre avis sur ce que je propose. Si vous aviez le temps et l'envie je serai intéressé pour savoir comment vous auriez fait pour répondre au problème. Dans le même esprit (et c'est pour cela que j'aimerai pouvoir combiner l'ensemble,...chose possible d'aprés Patrick_35, ) insertion d'une barre double avec crochet à 45 ° de part et d'autre : ; ******************************************************************* ; bdoublenom.LSP ; ;(modes '("CMDECHO" "ATTDIA" "ATTREQ" "GRIDMODE" "UCSFOLLOW")) ;(setvar "cmdecho" 0) ; turn cmdecho off ;(setvar "attdia" 0) ; turn attdia off ;(setvar "attreq" 1) ; turn attreq on ;(setvar "gridmode" 0) ; turn gridmode off ;(setvar "ucsfollow" 0) ; turn ucsfollow off (defun C:bd4545nom () (setq p3 (getpoint "\pt d'insertion nomenclature : ")) (command "_.insert"" NOM BD4545 " p3 1 1 "") (command "_.explode" "d") (setq p2 (getpoint "\pt d'insertion bloc : ")) (command "_.insert"" HA crochet double 45° 45° " p2 1 1"") (setq p4 (getpoint "\pt d'insertion repere acier : ")) (command "_.insert"" rep acier barre " p4 1 1 "") (setq p5 (getpoint "\pt intermediere de ligne de repere : ")) (command "_.pline" p4 p5 "") (command "CHANGER" "d" "" "p" "ca" "BAC FERRAILLAGE REPERE PLAN" "") (setq p6 (getpoint "\pt insertion numero de repere : ")) (command "_.pline" p5 p6 "") (command "CHANGER" "d" "" "p" "ca" "BAC FERRAILLAGE REPERE PLAN" "") (command "_.insert"" numerorepere " p6 1 1 "") (command "_.explode" "d")) , bref, ça reste la même chose mais pour moi, c'est déjà un grand pas ! Au plaisir.
-
challenge debutant seulement avec l\'aide de nos maitres....
lili2006 a répondu à un(e) sujet de lovecraft dans Débuter en LISP
Bonjour à toutes et tous, . Je suis assez d'accord avec toi et m'en excuse car découvrir le lisp et progresser m'intéresse vraiment. MAIS (parce qu'il y a toujours un mais!), cela reste trés difficile de rentrer dedans, même quand on sait ce que l'on veut faire.(Ce qui était ton cas pour ce challenge) Je viens tous juste de finaliser, suite aux conseils de nos maitres et expert ce dont j'ai traité en partie dans ce post et vous soumet le code pour critique, en espérant, lovecraft, qu'il te profite aussi car j'ai apprécié ta démarche. Suite sur le post citée plus haut. [Edité le 17/10/2007 par lili2006] -
challenge debutant seulement avec l\'aide de nos maitres....
lovecraft a répondu à un(e) sujet de lovecraft dans Débuter en LISP
ben voila j'ai fini une partie de ce challenge "mon challenge" puisque aucun aute debutant n'a participé. "je ne sais pas ce qu'il faut faire pour que d'autre peersonne puisse participer car il me semble que ce challenge etait a la hauteur de tout debutant. enfin bon Voici mon code: (defun sstext () (ssget "X" (list (cons 0 "*TEXT") (cons 8 "TEXTE_INDICE"))) ) ;************************************************************** (defun c:lstf () (setq jstext (sstext)) (setq listd nil) (setq i 0) (repeat (sslength jstext) (setq enttxt (ssname jstext i) bdenttxt (entget enttxt)) (setq listd (cons (atof(cdr(assoc 1 bdenttxt))) listd)) (setq i (+ 1 i)) );fin du repeat (setq listfin (vl-sort listd ' (setq fic (open "D:\\AUTOCAD CIVIL 2008 FICHIERS\\LISP\\new.txt" "w")) (setq k 0) (repeat (sslength jstext) (setq rfic (rtos (nth k listfin))) (write-line rfic fic) (setq k (+ 1 k)) );fin du repeat (close fic) );fin du defun PS: maintenant il me reste le plus dure de l'optimiser grave a vos commentaire que je vais reprendre et ceux à venir. Merci -
Et voilà, Mon premier challenge :)! En plus c'était mon numéro de maillot dans mon club de foot. Le but de ce challenge est de faire un petit jeu, on fera 2 parties. La première sera une préparation du terrain. Je vois déjà des :casstet: :o :exclam: . La première est je pense plus difficile que la seconde. Voilà le sujet de la première partie, qui est en fait deux fonctions: 1° (defun genere( nb)) => on doit renvoyé une liste de nb lettres de l'alphabet ex: (genere 3) => '("a" "d" "p") 2° (defun combi( lst min)) => lst est une liste de nb lettres de l'alphabet, et on doit renvoyé toutes les listes possibles de sorte que les éléments de lst soient triés alphabétiquement et que l'on prenne de nb à min lettres. (Je sais pas trop si cela va être clair, alors voici la suite de l'exemple) ex: (combi '("a" "d" "p") 1) => '(("a" "d" "p") ("a" "d") ("a" "p") ("d" "p") ("a") ("d") ("p") ) VOilà. On va attendre ce week-end pour donner des premiers jets. Bonne soirée.
-
Exemple d'utilisation du code généré par ce challenge (bah oui faut bien quand même !) : Optimisation de polyligne : (defun c:OPL (/ CMDECHO CN DENT ENT LST N NLST SEL) (princ "\nSélectionner les polylignes à optimiser : ") (setq cmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq sel (ssget)) (progn (command "_UNDO" "D") (repeat (setq cn (sslength sel)) (setq ent (ssname sel (setq cn (1- cn))) dent (entget ent) lst (remove-doubles (remove-align (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) ) (foreach pt (remove-all lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))) (setq n (vl-position pt dent)) (setq nlst (append (sublist dent 0 n) (sublist dent (+ n 4) nil) ) ) (setq dent nlst) ) (entmod nlst) (entupd ent) (princ "\nPolyligne optimisée.") ) ) ) (command "_UNDO" "F") (setvar "cmdecho" cmdecho) (princ) ) ;;; SUBLIST De GILE (defun sublist (lst start leng / n r) (if (or (not leng) (< (- (length lst) start) leng) ) (setq leng (- (length lst) start)) ) (setq n (+ start leng)) (repeat leng (setq r (cons (nth (setq n (1- n)) lst) r)) ) ) ;;; REMOVE-ALIGN De GILE (defun remove-align (lst / rslt) (while (caddr lst) (if (betweenp (car lst) (caddr lst) (cadr lst)) (setq lst (cons (car lst) (cddr lst))) (setq rslt (cons (car lst) rslt) lst (cdr lst) ) ) ) (append (reverse rslt) lst) ) ;;; REMOVE-DOUBLES De GILE (defun remove-doubles (lst) (if lst (cons (car lst) (remove-doubles (vl-remove (car lst) lst))) ) ) ;;; REMOVE-ALL ;;; Supprime tous les éléments d'une liste à partir d'une autre ;;; (REMOVE-ALL '(1 3 5) '(1 2 3 4 5 6 7)) -> (2 4 6 7) (defun REMOVE-ALL (lise lisc) (foreach pt lise (setq lisc (vl-remove pt lisc))) ) ;;; BETWEENP Evalue si pt est entre p1 et p2 (ou égal à) ;;;Lisp de GILE (defun betweenp (p1 p2 pt) (or (equal p1 pt 1e-9) (equal p2 pt 1e-9) (equal (vec1 p1 pt) (vec1 pt p2) 1e-9) ) ) ;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2 (nil si p1 = p2) ;;;Lisp de GILE (defun vec1 (p1 p2) (if (not (equal p1 p2 1e-009)) (mapcar '(lambda (x1 x2) (/ (- x2 x1) (distance p1 p2)) ) p1 p2 ) ) ) Voilà. Bon je sais mon code n'est pas des plus concis, et puis comme d'habitude, je n'ai pas du prendre en compte tous les cas de figures ! A bientot ! Matt. PS : Merci encore à vous pour ces très belles (je reste sur ma position de code "beau" bseb67 ;) ) routines qui nous font apprendre un peu plus ce langage ! [Edité le 15/10/2007 par Matt666]
-
challenge debutant seulement avec l\'aide de nos maitres....
Bred a répondu à un(e) sujet de lovecraft dans Débuter en LISP
OK, Pour être plus compréhensible (vue que c'est le premier challenge), je me permet d'expliquer un peu la base : Faites un Mutlti-Texte dans un calque TEXTE_INDICE au point x = 2.0 et y = 5.0. Dans l'édituer VL, créer un nouveau fichier et taper ceci : ([b]setq[/b] lst-sel ([b]entsel[/b] "\n Choix du texte :")) sélectionner ce code et "charger la selection". Vous devez alors avoir la main sur Autocad vous demandant de sélectionner le texte. Vous le selectionnez et vous devez avoir en retour sur la console (au "Nom d'entité près et aux coordonée près") : ... vous avez donc, dans la variable sel, le liste ci dessus. celle ci représente : l'entité texte et les coordonnées où vous avez cliquez. Ensuite vous taper cette ligne et vous la chargez : ([b]setq[/b] 1er-element-lst-sel ([b]car[/b] lst-sel)) Ce code vous retpurnera le 1er élément (car) de la liste "lst-sel" : Puis, enfin, tapez ceci et chargez-le : ([b]setq[/b] ent-sel ([b]entget[/b] 1er-element-lst-sel)) Cela vous retourneras une liste enregistré dans la variable ent-sel : Cette liste donnant certaines caractéristique de l'entité texte que vous avez sélectionnez ! -
challenge debutant seulement avec l\'aide de nos maitres....
(gile) a répondu à un(e) sujet de lovecraft dans Débuter en LISP
Salut, À propos de l'éditeur Visual LISP, j'ai commencé un nouveau sujet. Ça faisait un moment que je voulais le faire, ce challenge m'en donne l'occasion. Lovecraft, C'est un très bon début, il y a moyen d'optimiser un tout petit peu en évitant quelques expressions (c'est du détail qu'on pourra aborder plus tard...). -
Bonsoir, je me lance dans un challenge de débutant. Afin de sortir de l 'austérité du boulot, je souhaiterais fabriquer un jeu de bonneteau. (vous savez ce jeu de 3 cartes retournées où il faut retrouver la bonne). Ce thème pourrait faire l 'objet de choix d 'évolution. La première étape sera de faire dessiner 3 cartes . Elles seront rectangulaires en polyligne 2d de 10 de large sur 20 de haut, alignées horizontalement, séparées de 10 unités Le moins de lignes de code possible est souhaité, mais les commentaires sont les bienvenus, l 'objectif étant de faire connaître des possibilités d' utilisation. VBA bien sûr. [Edité le 21/10/2007 par nazemrap]
