ElpanovEvgeniy

Salut! J'utilise pour l'installation la ligne de commande *.cmd ou *.com Regardez le fichier - l'installation du programme à l'autochargement à toutes les versions autocad... instal.cmd SETLOCAL ENABLEEXTENSIONS ENABLEDELAYEDEXPANSION taskkill /f /im AutoCAD.exe reg add "HKCU\Software\KovchegCAD" /V path /D "%CD%" /F for /F "usebackq delims==" %%A IN (`reg query HKCU\Software\Autodesk\AutoCAD\ `) DO ( SET str=%%A IF "!str:~0,46!" EQU "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\\R" for /F "usebackq delims==" %%B IN (`reg query %%A `) DO ( SET str=%%B IF "!str:~51,5!" EQU "ACAD-" for /F "usebackq delims==" %%C IN (`reg query %%B\Profiles `) DO ( SET str=%%C set mn= set nn=0 IF not "!str:~64,9!"=="%%C" IF "!str:~64,9!"=="Profiles\" ( set pp="%%C\Dialogs\Appload\Startup" for /F "usebackq skip=4 tokens=1-4*" %%i IN (`reg query !pp! /V NumStartup `) do set nn=%%k for /F "usebackq skip=4 tokens=1-4*" %%i IN (`reg query !pp! `) DO if "%%j"=="%CD%\odg.VLX" set mn="%%j" for /F "usebackq skip=4 tokens=1-2*" %%i IN (`reg query !pp! `) DO if "%%~nxk"=="odg.VLX" reg delete "%%C\Dialogs\Appload\Startup" /V %%i /F if "!nn!"=="" set nn=0 if "!nn!"=="0" ( reg add !pp! /V NumStartup /D 1 /F reg add !pp! /V 1Startup /D "%CD%\odg.VLX" /F ) else ( set /A nn=!nn! + 1 reg add !pp! /V NumStartup /D "!nn!" /F reg add !pp! /V !nn!Startup /D "%CD%\odg.VLX" /F ) ) IF not "!str:~65,9!"=="%%C" IF "!str:~65,9!"=="Profiles\" ( set pp="%%C\Dialogs\Appload\Startup" for /F "usebackq skip=4 tokens=1-4*" %%i IN (`reg query !pp! /V NumStartup `) do set nn=%%k for /F "usebackq skip=4 tokens=1-4*" %%i IN (`reg query !pp! `) DO if "%%j"=="%CD%\odg.VLX" set mn="%%k" for /F "usebackq skip=4 tokens=1-2*" %%i IN (`reg query !pp! `) DO if "%%~nxk"=="odg.VLX" reg delete "%%C\Dialogs\Appload\Startup" /V %%i /F if "!nn!"=="" set nn=0 if "!nn!"=="0" ( reg add !pp! /V NumStartup /D 1 /F reg add !pp! /V 1Startup /D "%CD%\odg.VLX" /F ) else ( set /A nn=!nn! + 1 reg add !pp! /V NumStartup /D "!nn!" /F reg add !pp! /V !nn!Startup /D "%CD%\odg.VLX" /F ) ) ) ) ) goto :eof ENDLOCAL

Salut! :) J'utilise d'habitude vl-string-translate

Salut :) Je félicite! Vous êtes très de surveillance.

Bonjour :) Vous attendez mon code ? Probablement, je comprends mal. Je pensais, vous ne vouliez pas à la fois exposer un nouveau code... Dans tous les cas, j'expose le code, qui a écrit vendredi soir. (defun sort-1 (l) (setq ma nil mi nil a (car l) ) ;_ setq (foreach b (cdr l) (if (f a B) (setq ma (cons b ma)) (setq mi (cons b mi)) ) ;_ if ) ;_ foreach ) (defun sort (lst f / A L-ALL MA MI) (setq lst (list lst) f (eval f) ) ;_ setq (while lst (if (cdar lst) (progn (sort-1 (car lst)) (if (and mi (null (cdr mi))) (setq l-all (cons a (cons (car mi) l-all)) lst (if ma (cons (reverse ma) (cdr lst)) (cdr lst) ) ;_ if ) ;_ setq (setq lst (cons mi (cons (list a) (if ma (cons (reverse ma) (cdr lst)) (cdr lst) ) ;_ if ) ;_ cons ) ;_ cons ) ;_ setq ) ;_ if (if (null (car lst)) (setq lst (cdr lst)) ) ;_ if ) ;_ progn (setq l-all (cons (caar lst) l-all) lst (cdr lst) ) ;_ setq ) ;_ if ) ;_ while (reverse l-all) ) ;; test: ;;(setq lst '("f" "a" "b" "d" "e" "c") f '< l-all nil) ;;(sort lst f)

>Patrick_35 >(gile) Vous m'avez intrigué! J'ai écrit le programme avant le temps planifié... Je n'utilise pas vl* (benchmark '((sort-evgeniy lst '<) (bubblesort lst '<))) (length lst) ; => 2053 (int) reponse n°12 postee le 18/1/2008 a 07:38 Benchmarking .....Elapsed milliseconds / relative speed for 4 iteration(s): (SORT LST (QUOTE <))............1125 / 78.21 <fastest> (BUBBLESORT LST (QUOTE <)).....87985 / 1.00 <slowest>

Avec une liste longue Donc, je vais faire comme vous et attendre avant de poster ma routine ps : J’ai bien regardé les différents algorithmes, mais cela n'est pas évident à comprendre et à retranscrire. J'ai donc préféré le faire selon ma logique et les possibilités du lisp. @+ Si remplacer vl-remove par la fonction analogue autolisp - tout changera!

Je relève le défi remis! Maintenant j'ai beaucoup de travail et je ne pourrai pas écrire la réponse digne vite. La semaine suivante, pour ce sujet, j'écrirai la fonction du tri sans recursion.

Bonjour ! Regardez mon contrôle pour de grandes listes. Recursion ne peut pas être le plus rapide, si les données il y a beaucoup de. :( Test list: (setq lst (apply (function append) (mapcar (function vl-string->list) '("(defun bubble (ele lst fun) ;;gile (if lst (if ((eval fun) ele (car lst)) (cons ele (bubble (car lst) (cdr lst) fun)) (cons (car lst) (bubble ele (cdr lst) fun)) ) ;_ if (list ele) ) ;_ if ) ;_ defun " " (defun bubblesort (lst fun) (if lst (bubble (car lst) (bubblesort (cdr lst) fun) fun) ) ;_ if ) ;_ defun " " (defun tri_pat (lst fun / der tbl val) ;;Patrick_35 (while lst (setq n 0 der (car lst) tot (length lst) ) ;_ setq (while (setq val (nth n lst)) (if ((eval fun) der val) (setq der val) ) ;_ if (setq n (1+ n)) ) ;_ while (setq lst (vl-remove der lst)) (repeat (- tot (length lst)) (setq tbl (cons der tbl))) ) ;_ while tbl ) ;_ defun " " (defun left (ele lst fun) (if lst (if ((eval fun) ele (car lst)) (left ele (cdr lst) fun) (cons (car lst) (left ele (cdr lst) fun)) ) ;_ if ) ;_ if ) ;_ defun " " (defun right (ele lst fun) (if lst (if ((eval fun) ele (car lst)) (cons (car lst) (right ele (cdr lst) fun)) (right ele (cdr lst) fun) ) ;_ if ) ;_ if ) ;_ defun " " (defun quicksort (lst fun) ;;gile (if (cdr lst) (append (quicksort (left (car lst) (cdr lst) fun) fun) (cons (car lst) (quicksort (right (car lst) (cdr lst) fun) fun)) ) ;_ append lst ) ;_ if ) ;_ defun " " (defun rec-quicksort-2 (lst lst1 lst2 test f) (cond ((not lst) (list lst1 (list test) lst2)) (((eval f) (car lst) test) (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test f) ) (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test f)) ) ;_ cond ) ;_ defun " " (defun rec-quicksort-1 (lst f) (cond ((not lst) nil) ((not (car lst)) (rec-quicksort-1 (cdr lst) f)) ((not (cdar lst)) (cons (caar lst) (rec-quicksort-1 (cdr lst) f))) ((not (cddar lst)) (if (apply f (car lst)) (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst) f))) (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst) f))) ) ;_ if ) (t ((lambda (x) (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))) f) ) ;_ lambda (rec-quicksort-2 (cdar lst) nil nil (caar lst) f) ) ) ) ;_ cond ) ;_ defun " " (defun tri (lst f) ;;ElpanovEvgeniy (rec-quicksort-1 (list lst) f) ) ;_ defun" ) ) ;_ mapcar ) ;_ apply ) test: (benchmark '((tri lst '<) (quicksort lst '<) (tri_pat lst '<) (bubblesort lst '<))) Benchmarking ....Elapsed milliseconds / relative speed for 2 iteration(s): (TRI_PAT LST (QUOTE <)).........2063 / 31.14 <fastest> (TRI LST (QUOTE <)).............5625 / 11.42 (QUICKSORT LST (QUOTE <))......10171 / 6.32 (BUBBLESORT LST (QUOTE <)).....64250 / 1 <slowest>

:) http://www.caduser.ru/cgi-bin/f1/board.cgi?t=25113OT (2006-05-10 23:18:41) (defun rec-quicksort-2 (lst lst1 lst2 test f) (cond ((not lst) (list lst1 (list test) lst2) ) (((eval f) (car lst) test) (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test f) ) (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test f)) ) ;_ cond ) ;_ defun (defun rec-quicksort-1 (lst f) (cond ((not lst) nil) ((not (car lst)) (rec-quicksort-1 (cdr lst) f)) ((not (cdar lst)) (cons (caar lst) (rec-quicksort-1 (cdr lst) f)) ) ((not (cddar lst)) (if (apply f (car lst)) (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst) f))) (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst) f))) ) ;_ if ) (t ((lambda (x) (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))) f) ) ;_ lambda (rec-quicksort-2 (cdar lst) nil nil (caar lst) f) ) ) ) ;_ cond ) ;_ defun (defun tri (lst f) (rec-quicksort-1 (list lst) f) ) ;_ defun

(defun tri (lst fun) (mapcar (function (lambda (x) (nth x lst) ) ;_ lambda ) ;_ function (vl-sort-i lst fun) ) ;_ mapcar ) ;_ defun

Je voulais montrer seulement un autre moyen de l'instruction du point - lui plus confortablement... Mon programme précédent, comme tienne, utilisait l'instruction de l'angle. http://www.theswamp.org/index.php?topic=8878.msg114384#msg114384 (defun C:LW_ARC (/ A1 ENT GR I LST LW PAR PT) ;**************** lW_arc.lsp ************************************* ; Substitution of a linear segment in a polyline ; The arc segment. ; Writer Evgeniy Elpanov. (vl-load-com) (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object))) (setq lw (entsel "\n Select the necessary segment in a polyline. ")) (if (and lw (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE")) (progn (setq par (vlax-curve-getParamAtPoint (car lw) (vlax-curve-getClosestPointTo (car lw) (cadr lw)) ) ;_ vlax-curve-getParamAtPoint a1 (angle (vlax-curve-getPointAtParam (car lw) (fix par)) (vlax-curve-getPointAtParam (car lw) (1+ (fix par))) ) ;_ angle ) ;_ setq (princ "\n Set visually a curvature of a segment. ") (while (and (setq gr (grread 5)) (= (car gr) 5)) (setq i 0 lst nil ent (entget (car lw)) ) ;_ setq (while (or (/= (caar ent) 42) (if (< i (fix par)) (setq i (1+ i)) ) ;_ if ) ;_ or (setq lst (cons (car ent) lst) ent (cdr ent) ) ;_ setq ) ;_ while (redraw) (grdraw (setq pt (vlax-curve-getPointAtParam (car lw) (fix par)) ) ;_ setq (cadr gr) 6 1 ) ;_ grdraw (entmod (append (reverse (cons (cons 42 (/ (sin (/ (- a1 (angle pt (cadr gr))) 2.)) (cos (/ (- a1 (angle pt (cadr gr))) 2.)) ) ;_ / ) ;_ cons lst ) ;_ cons ) ;_ reverse (cdr ent) ) ;_ append ) ;_ entmod (entupd (car lw)) ) ;_ while ) ;_ progn (princ "\n It is selected nothing or plant not a polyline. ") ) ;_ if (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object))) (redraw) (princ) )

Le salut gile! :) Fais attention à mon vieux programme. Dans elle l'autre calcul de la courbure... http://www.theswamp.org/index.php?topic=8878.msg132615#msg132615 (defun C:LW_ARC (/ LW i P1 P2 P3) ;**************** lw_arc.lsp ************************************* ; Substitution of a linear segment in a polyline ; The arc segment. ; Writer Evgeniy Elpanov. ; Last edit 04.06.06 (vl-load-com) (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (setq lw (entsel "\n Select the necessary segment in a polyline. ")) (= (cdr (assoc 0 (entget (car lw)))) "LWPOLYLINE") ) ;_ and (progn (setq i (fix (vlax-curve-getParamAtPoint (car lw) ;_ car (vlax-curve-getClosestPointTo (car lw) (cadr lw)) ) ;_ vlax-curve-getParamAtPoint ) ;_ fix p1 (vlax-curve-getPointAtParam (car lw) i) p3 (vlax-curve-getPointAtParam (car lw) (1+ i)) lw (vlax-ename->vla-object (car lw)) ) ;_ setq (princ "\n Set visually a curvature of a segment. ") (vla-StartUndoMark doc) (while (and (setq p2 (grread 5)) (= (car p2) 5)) (vla-SetBulge lw i ((lambda (a) (/ (sin a) (cos a))) (/ (- (angle p1 (cadr p2)) (angle (cadr p2) p3)) -2.) ) ) ;_ vla-SetBulge ) ;_ while (vla-EndUndoMark doc) ) ;_ progn (princ "\n It is selected nothing or plant not a polyline. ") ) ;_ if ) ;_ defun

(defun test (a b f d) ;|arguments: a = start parametr function b = end parametr function f = Any graphic function As an example - function of parabola (lambda(x)(- (* x x) 12.)) d = precision (test 3. 4. (lambda(x)(- (* x x) 12.)) 0.00001) search inters parabola '(lambda(x)(- (* x x) 12.)) Axis X y = (- (* x x) 12.) if y=0 x=?? |; (if (= a b) nil ((lambda (r) (if (equal (f r) 0. d) r (if (minusp (* (f a) (f r))) (test a r f d) (test r b f d) ) ;_ if ) ;_ if ) ;_ lambda (/ (+ a b) 2.) ) ) ;_ if ) ;_ defun (test 2. 4. (lambda(x)(- (* x x) 5.)) 1e-5) ;=> 2.23607 (test 2. 4. (lambda(x)(-(* 5. x x x)100.)) 1e-5) ;=> 2.71442 (test 2. 4. (lambda(x)(+(* 2. x x x)(* 3. x x)(* 4. x) -100.)) 1e-5) ;=> 3.08986

:) (defun test (l) ;; (test '("A" "B" "C" "D")) (defun rem-nth (l i) ;;(rem-nth '("A" "B" "C" "D") 2) ;=> '("A" "B" "D") (if l (if (zerop i) (cdr l) (cons (car l)(rem-nth (cdr l) (1- i)))))) (defun count-lst (i) ;;(count-lst 4) ;=> '(3 2 1 0) (if (> i 0) (cons (1- i)(count-lst (1- i))))) (defun combin (a b) ;; (combin '("A" "B" "C" "D") '(3 2 1 0)) (if a (apply 'append (mapcar '(lambda (x) ((lambda(y)(cons y (combin y (cdr b))))(rem-nth a x))) b)) ) ;_ if ) ;_ defun (defun remove (l a) ;; (remove '(3 nil 2 1 () 2 0 0) 0) (if l (if (equal a (car l)) (remove (cdr l)a) (cons (car l)(remove (cdr l)a))))) (defun remove-nil_dupl (l) ;; (remove-nil_dupl '(3 nil 2 1 () 2 0 0)) (if l (if (car l) (cons (car l)(remove-nil_dupl(remove (cdr l) (car l)))) (remove-nil_dupl (cdr l))))) (cons l(remove-nil_dupl (combin l (count-lst (length l)))))) (test '("A" "B" "C" "D")) '(("A" "B" "C" "D") ("A" "B" "C") ("A" "B") ("A") ("B") ("A" "C") ("C") ("B" "C") ("A" "B" "D") ("A" "D") ("D") ("B" "D") ("A" "C" "D") ("C" "D") ("B" "C" "D") )

Hier, a écrit pour les étudiants, le programme très semblable... http://fr.wikipedia.org/wiki/Méthode_de_dichotomie (defun test (a b f d) (if (= a b) nil ((lambda (r) (if (equal (f r) 0. d) r (if (minusp (* (f a) (f r))) (test a r f d) (test r b f d) ) ;_ if ) ;_ if ) ;_ lambda (/ (+ a b) 2.) ) ) ;_ if ) ;_ defun ;| Le contrôle (test 2 1.6 (lambda(x)(- (* x x) 12.)) 0.00001) (test 3. 4. (lambda(x)(- (* x x) 12.)) 0.00001) (test -3. -4. (lambda(x)(- (* x x) 12.)) 0.00001) |;

Dans tels sujets, je fais toujours un nouveau programme! Autrement, ce n'est pas intéressant...

S'il vous plaît! On regrette qu'il y a longtemps il n'y a pas de compétitions complexes...

(defun test (l p) (if (and l p) (if (> (car p) 1) (cons (car l) (test (cdr l) (mapcar '1- p))) (test (cdr l) (mapcar '1- (cdr p))) ) ;_ if l ) ;_ if ) ;_ defun (test '(1 2 3 4 5 6 7 8 9 10 11 12 23) '(7 8 9)) ;=> '(1 2 3 4 5 6 10 11 12 23) (test '(1 2 3 4 5 6 7 8 9 10 11 12 23 7 8 9 15 8) '(7 8 9)) ;=> '(1 2 3 4 5 6 10 11 12 23 7 8 9 15 8) (test '(0 0 0 1 2 5 4 0 1 2 4 0 0 1 2 5 0 5 8 4 0) '(11 12)) ;=> '(0 0 0 1 2 5 4 0 1 2 0 1 2 5 0 5 8 4 0)

bag in line 72-74 (if (eq (type pt) 'STR) ;if ;?? )

(read "0123") ; => 123 (atoi "0123") ; => 123 (atof "0123") ; => 123.0 (distof "0123"); => 123.0 (princ 0123) ; => 123 (print 0123) ; => 123

Alexander Rivilis - la correspondance avec ADN:

for last version autocad, to *error* program: (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) (strcat (chr 27)(chr 27)"_.undo 1 "))

:) (defun test-for-bench (s) (defun test1 (a b f) (cond ((null b) (list (if f (cond ((vl-position 46 a) (atof (vl-list->string (reverse a)))) ((vl-position 47 a) (distof (vl-list->string (reverse a)))) ((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a))))) (t (atoi (vl-list->string (reverse a)))) ) ;_ cond (vl-list->string (reverse a)) ) ;_ if ) ;_ list ) (f (if (or (= (car b) 44) (< 45 (car b) 58)) (test1 (cons (car b) a) (cdr b) f) (cons (cond ((vl-position 46 a) (atof (vl-list->string (reverse a)))) ((vl-position 47 a) (distof (vl-list->string (reverse a)))) ((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a))))) (t (atoi (vl-list->string (reverse a)))) ) ;_ cond (test1 (list (car b)) (cdr b) nil) ) ;_ cons ) ;_ if ) (t (if (< 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) 44) (< 45 (car s) 58)) t ) ;_ if ) ;_ test1 ) :) (TEST-FOR-BENCH "point.25.4cm.") ; => ("point." 25.4 "cm.") (TEST-FOR-BENCH "point.25,4cm.") ; => ("point." 25.4 "cm.") (TEST-FOR-BENCH "point.3/8cm.") ; => ("point." 0.375 "cm.") (challenge10gile4 "qvf12qsdf125 5sf 56dfv2") ; => ("qvf" 12 "qsdf" 125 " " 5 "sf " 56 "dfv" 2) (test-for-bench "qvf12qsdf125 5sf 56dfv2") ; => ("qvf" 12 "qsdf" 125 " " 5 "sf " 56 "dfv" 2) (BenchMark '((challenge10gile4 "qvf12qsdf125 5sf 56dfv2") (test-for-bench "qvf12qsdf125 5sf 56dfv2") ) ) ;_ BenchMark Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (TEST-FOR-BENCH "qvf12qsdf125 5sf 56...).....1984 / 1.11 (CHALLENGE10GILE4 "qvf12qsdf125 5sf ...).....2203 / 1 (challenge10gile4 "point.25.4cm.") ; => ("point." 25.4 "cm.") (test-for-bench "point.25.4cm.") ; => ("point." 25.4 "cm.") (BenchMark '((challenge10gile4 "point.25.4cm.") (test-for-bench "point.25.4cm."))) Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (TEST-FOR-BENCH "point.25.4cm.").......1235 / 1.16 (CHALLENGE10GILE4 "point.25.4cm.").....1438 / 1 (challenge10gile4 "point.25,4cm.") ; => ("point." 25 "," 4 "cm.") (test-for-bench "point.25,4cm.") ; => ("point." 25.4 "cm.") (BenchMark '((challenge10gile4 "point.25,4cm.")(test-for-bench "point.25,4cm."))) Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (TEST-FOR-BENCH "point.25,4cm.").......1266 / 1.1 (CHALLENGE10GILE4 "point.25,4cm.").....1391 / 1 (challenge10gile4 "point.3/8cm.") ; => ("point." 3 "/" 8 "cm.") (test-for-bench "point.3/8cm.") ; => ("point." 0.375 "cm.") (BenchMark '((challenge10gile4 "point.3/8cm.")(test-for-bench "point.3/8cm."))) Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (TEST-FOR-BENCH "point.3/8cm.").......1187 / 1.12 (CHALLENGE10GILE4 "point.3/8cm.").....1328 / 1 edit = fix bag... [Edité le 14/10/2007 par ElpanovEvgeniy]

Oui, je ne contrôle pas tels cas... "point.25.4cm." "25,4cm." "3/8cm"

Je ne connais pas du tout la langue française... Mes commentaires seront ridicules! Je demande gile d'aider.