ElpanovEvgeniy

(defun test-for-bench (s / a ) (defun test1 (a b f) (cond ((null b) (list (if f ((if (vl-position 46 a) atof atoi ) ;_ if (vl-list->string (reverse a)) ) (vl-list->string (reverse a)) ) ;_ if ) ;_ list ) (f (if (or (= (car b) 46) (< 47 (car b) 58)) (test1 (cons (car b) a) (cdr b) f) (cons ((if (vl-position 46 a) atof atoi ) ;_ if (vl-list->string (reverse a)) ) (test1 (list (car b)) (cdr b) nil) ) ;_ cons ) ;_ if ) (t (if (or (= (car b) 46) (< 47 (car b) 58)) (cons (vl-list->string (reverse a)) (test1 (list (car b)) (cdr b) t)) (test1 (cons (car b) a) (cdr b) nil) ) ;_ if ) ) ;_ cond ) ;_ defun (setq s (vl-string->list s)) (test1 (list (car s)) (cdr s) (if (or (= (car s) 46) (< 47 (car s) 58)) t ) ;_ if ) ;_ test1 ) Salut gile! :) recursion, spécialement pour le contrôle de la vitesse... (setq s "qvf12qsdf125 5sf 56dfv2") (BenchMark '((challenge10gile3 s)(test-for-bench s))) Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s): (TEST-FOR-BENCH S).......1390 / 1.16 (CHALLENGE10GILE3 S).....1610 / 1 [Edité le 12/10/2007 par ElpanovEvgeniy]

(defun test (s) ;;(test s) (if (listp s) (cond ((= (ascii (last s)) 0) (if (car s) (list(car s)) (list((if (wcmatch (cadr s) "*.*") atof atoi) (cadr s))) ) ;_ if ) ((car s) (if (or (= (ascii (cadr s)) 46) (< 47 (ascii (cadr s)) 58)) (cons (car s) (test (cadr s))) (test (list (strcat (car s) (substr (last s) 1 1)) (substr (last s) 2))) ) ;_ if ) (t (if (or (= (ascii (caddr s)) 46) (< 47 (ascii (caddr s)) 58)) (test (list nil (strcat (cadr s) (substr (caddr s) 1 1)) (substr (caddr s) 2))) (cons ((if (wcmatch (cadr s) "*.*") atof atoi) (cadr s)) (test (caddr s))) ) ;_ if ) ) ;_ cond (cond ((= (ascii s) 0) nil) (t (if (or (= (ascii s) 46) (< 47 (ascii s) 58)) (test (list nil (substr s 1 1) (substr s 2))) (test (list (substr s 1 1) (substr s 2))) ) ;_ if ) ) ;_ cond ) ;_ if )

(defun add-acad_wipeout_vars (/ e) ;; By ElpanovEvgeniy ;; 2006-12-15 ;; http://forums.augi.com/showthread.php?t=52082 ;; add acad_wipeout_vars to DICTIONARY... ;; tested AutoCAD 2005, 2007 (and (ARXLOAD "AcWipeout.arx") (setq e (entmakex (list '(0 . "WIPEOUTVARIABLES") '(102 . "{ACAD_REACTORS") (cons 330 (NAMEDOBJDICT)) '(102 . "}") (cons 330 (NAMEDOBJDICT)) '(100 . "AcDbWipeoutVariables") '(70 . 1) ) ;_ list ) ;_ entmakex ) ;_ setq (entmod (append (entget (NAMEDOBJDICT)) (list '(3 . "ACAD_WIPEOUT_VARS") (cons 350 e) ) ;_ list ) ;_ append ) ;_ entmod ) ;_ and )

(vl-every .........

Je ne suis pas sûr qu'a compris la tâche... (if (setq sel (ssget "_x" (list (cons 8 (getvar "clayer"))))) (setq sel (mapcar '(lambda (x) (entmakex(entget (cadr x)))) (ssnamex sel))) )

J'occupe le tour, après toi.

Oui, cela ainsi. Pour chaque devinette, on peut regarder de diffйrentes parties... (vl-remove-if '(lambda (x) (wcmatch (itoa x) "*[13579]")) lst)

:D (vl-remove-if '(lambda (x) (wcmatch (rtos (/ x 2.) 2 2) "*.[1-9]*")) lst)

Je m'excuse fortement! Je connaissais à la fois la réponse au devoir. On regrette, mais j'ai abîmé le jeu... :(

Je comprends le code mais pas la réponse :casstet: @+ :exclam: (defun bascule (v i) (setvar v (Boole 6 i (getvar v))))

(vl-remove-if-not '(lambda (x) (zerop(boole 1 x 1))) lst) (vl-remove-if '(lambda (x) (= x (logior x 1))) lst) (vl-remove-if-not '(lambda (x) (= x (* (/ x 2) 2))) lst)

(if (= scf1 0) (setq scf1 1) [surligneur] (setq scf1 0) [/surligneur] ) (setq scf1 (abs(1- scf1))) [Edité le 24/5/2007 par ElpanovEvgeniy]

Bonjour! Ma variante de la fonction, le calcul de la place de la projection du polygone. (defun eea-area-polygon (lst) ;| By ElpanovEvgeniy Algorithm of function: (+ (* (+ x1 x2)(- y1 y2) 0.5)(* (+ x2 x3)(- y2 y3) 0.5) .... ) Example of use: (eea-area-polygon (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (entsel))) ) ;_ vl-remove-if-not ) ;_ mapcar ) ;_ area-polygon |; (/ (abs (apply (function +) (mapcar (function (lambda (a b) (* (+ (car a) (car b)) (- (cadr a) (cadr b)))) ) ;_ function (cons (last lst) lst) lst ) ;_ mapcar ) ;_ apply ) ;_ abs 2. ) ;_ / ) ;_ defun

Merci! A corrigй...

(defun test5 (lst) (if lst (cons (cons (car lst) (length (vl-remove-if-not '(lambda (x) (equal x (car lst))) lst))) (test5 (vl-remove (car lst) lst)) ) ;_ cons ) ;_ if ) ;_ defun (setq lst '("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a" 1 2 1 nil 1 1 2 nil)) returne '(("a" . 3) ("b" . 2) ("c" . 3) ("f" . 2) ("g" . 1) ("t" . 1) (1 . 4) (2 . 2) (nil . 2)) [Edité le 23/5/2007 par ElpanovEvgeniy]

Merci! Je suis corrigé... (defun dec (s / i) (setq i (1-(strlen s))) (apply (function +) (mapcar (function (lambda (x) (* (1- x) (lsh 16 (* 4 (setq i (1- i))))))) (VL-STRING->LIST (vl-string-translate "0123456789ABCDEF" "\001\002\003\004\005\006\007\010\t\n\013\014\r\016\017\020" (strcase s) ) ;_ vl-string-translate ) ;_ VL-STRING->LIST ) ;_ mapcar ) ;_ apply )

(defun dec (s / i) (setq i (- (strlen s) 0)) (apply (function +) (mapcar (function (lambda (x) (* (1- x) (lsh 16 (setq i (1- i)))))) (VL-STRING->LIST (vl-string-translate "0123456789ABCDEF" "\001\002\003\004\005\006\007\010\t\n\013\014\r\016\017\020" (strcase s) ) ;_ vl-string-translate ) ;_ VL-STRING->LIST ) ;_ mapcar ) ;_ apply )

Salut! Ma variante. :) (vl-remove-if-not '(lambda (x) (zerop(logand x 1))) lst)

bonjour :) (defun check_inters (p1 p2 p3 p4) ;; By ElpanovEvgeniy ;; Check intersect two lines ;; only 2D (equal (apply '- (mapcar '* (cdr (reverse (mapcar '- p4 p3))) (mapcar '- p2 p1))) 0. 1e-8 ) )

:) (defun inc-lst2 (new old pos) (or (= (type pos) 'INT) (setq pos (1+ (vl-position pos old)))) (apply 'append (mapcar '(lambda (x) (setq pos (1- pos)) (if (= -1 pos) (append new (list x)) (list x) ) ;_ if ) ;_ lambda old ) ;_ mapcar ) ;_ apply )

Salut :) (defun inc-lst (new old pos) ;; (inc-lst new old pos) (cond ((not (equal (type pos) 'INT)) (inc-lst new old (1+ (vl-position pos old)))) ((> pos 0) (cons (car old) (inc-lst new (cdr old) (1- pos)))) (t (append new old)) ) ;_ cond )

Bonjour :) (defun check (a b i) (cond ((not (and a b)) nil) ((> i 0) (check (cdr a) (cdr b) (1- i))) ((< (car a) (car b))) ((= (car a) (car b)) (check (cdr a) (cdr b) 0)) ) ;_ cond ) ;_ defun (defun test (lst pos) (vl-sort lst '(lambda (a b) (check a b pos))))

(setq l '( "vis" "vis" "ecrou" "vis" "vis" "ecrou")) variant 1 (apply '+(mapcar '(lambda(x)(if (= x "vis")1 0))l)) variant 2 (defun count (l x) (if (= x (car l)) (1+ (count (cdr l) x)) (if l (count (cdr l) x) 0 ) ;_ if ) ;_ if ) ;_ defun (count l "vis") [Edité le 11/4/2007 par ElpanovEvgeniy]

Salut! Ajoute а la fin du programme (princ)

Salut! :) (command "_-block" "Mon_Bloc" "_none" '(0 0 0) ss "") (if (setq ss (ssget)) (progn (setq doc (vla-get-activedocument (vlax-get-acad-object)) lst (mapcar (function vlax-ename->vla-object) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))) ) ;_ mapcar blk (vla-add (vla-get-blocks doc) (vlax-3d-point 0. 0. 0.) "test-block") barr (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray '9 (cons 0 (1- (length lst)))) lst)) ) ;_ setq (vla-copyobjects doc barr blk) ) ;_ progn ) ;_ if (command "_-INSERT" "Mon_Bloc" "_none" '(0 0 0) "1" "1" 0) (vla-insertblock (vla-get-ModelSpace doc) (vlax-3d-point 0. 0. 0.) "test-block" 1. 1. 1. 0.)