ElpanovEvgeniy

Une autre variante... (defun BrowseFolder (/ ShlObj Folder FldObj OutVal) ;; ;; Originated by Tony Tanzillo Adsk Discussion. ;; (vl-load-com) (setq ShlObj (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application" ) Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 0) ) (vlax-release-object ShlObj) (if Folder (progn (setq FldObj (vlax-get-property Folder 'Self) OutVal (vlax-get-property FldObj 'Path) ) (vlax-release-object Folder) (vlax-release-object FldObj) OutVal ) ) )

:) :) (vl-cmdf "shell" (strcat "FOR /F \"usebackq delims===\" %i IN (`dir \"" (getenv "ProgramFiles")"\\*acad.exe\" /s /b`) do echo.\"%~fi\">> d:\\temp.txt")) temp.txt: "C:\Program Files\AutoCAD 2004\acad.exe" "C:\Program Files\AutoCAD 2007\acad.exe"

Autodesk can change ACET-functions in each new version... You owner LISP of functions - you can change the program at any time!

ACET peut changer dans n'importe quelle version, mais LISP vous-mêmes, vous changez, s'il faut!

(setq data (entget (setq ne (car (entsel))))) (setq ajout (cons 62 8)) (setq data2 (subst ajout (assoc 62 data) data)) (entmod data2) (entupd ne) Ou (defun c:test (/ ne) (if (setq ne (car (entsel))) (progn (entmod (subst '(62 . 8) (assoc 62 (entget ne)) (entget ne))) (entupd ne) ) ) )

:) (defun GetFolders (p) ;(GetFolders '("C:\\Program Files\\AutoCAD 2004")) (if p (append p (GetFolders (apply (function append) (mapcar (function (lambda (b) (mapcar (function (lambda (a) (strcat b "\\" a))) (vl-remove ".." (vl-remove "." (vl-directory-files b nil -1)) ) ) ) ) p ) ) ) ) ) )

(ACET-FILE-DIR "acad.exe" "C:\\Program Files") (ACET-FILE-DIR "acad*.lsp" "C:\\Program Files")

Cette version cherche seulement le premier fichier... (defun GetFirstFile (f p) (cond ((not p) nil) ((vl-directory-files (car p) f)(strcat (car p) "\\"(car (vl-directory-files (car p) f)))) ((GetFirstFile f (append (mapcar (function (lambda (x) (strcat (car p) "\\" x))) (vl-remove ".." (vl-remove "." (vl-directory-files (car p) nil -1))) ) ;_ mapcar (cdr p) ) ;_ append ) ;_ GetFirstFile ) ) ;_ cond ) ;_ defun Test: (GetFirstFile "acad.exe" '("C:")) =>> "C:\\Program Files\\AutoCAD 2004\\acad.exe"

Oops... Dans le programme l'erreur, je suis corrigй. (defun GetFile (f p) (apply (function append) (cons (if (vl-directory-files p f) (mapcar (function (lambda (x) (strcat p "\\" x))) (vl-directory-files p f)) ) ;_ if (mapcar (function (lambda (x) (GetFile f (strcat p "\\" x)))) (vl-remove ".." (vl-remove "." (vl-directory-files p nil -1))) ) ;_ mapcar ) ;_ cons ) ;_ apply )

(defun GetFile (f p) (if (vl-directory-files p f) (mapcar (function (lambda (x) (strcat p "\\" x))) (vl-directory-files p f)) (apply (function append) (mapcar (function (lambda (x) (GetFile f (strcat p "\\" x)))) (vl-remove ".." (vl-remove "." (vl-directory-files p nil -1))) ) ) ) )

Merci (gile)! Vous avez aidй а comprendre la question... :) (defun GetFile (f p) (cond ((vl-directory-files p f) (mapcar (function (lambda (x) (strcat p "\\" x))) (vl-directory-files p f)) ) ((apply (function append) (mapcar (function (lambda (x) (GetFile f (strcat p "\\" x)))) (vl-remove ".." (vl-remove "." (vl-directory-files p nil -1))) ) ;_ mapcar ) ;_ apply ) (t nil) ) ;_ cond ) ;_ defun Le contrфle (getfile "acad.exe" "C:") ; =>> '("C:\\Program Files\\AutoCAD 2004\\acad.exe") (getfile "acad*.lsp" "C:\\Program Files") ; =>> '("C:\\Program Files\\AutoCAD 2004\\Express\\acadinfo.lsp" "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004.lsp" "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004doc.lsp" "C:\\Program Files\\AutoCAD 2004\\Support\\acadinfo.lsp" )

Cela non ce que vous cherchiez, mais un non mauvais exemple du traitement de tous les des directoires et les fichiers... Probablement cela vous intйressera! PS. Je regrette beaucoup, et n'a pas compris la tвche livrйe (je ne connais pas que le programme, qui vous est nйcessaire doit faire)... ;;------------------------------------------------- ;; la Commande : M_DWG_GEN ;; 2005-08-02 ;; ;; la Fonction pour la gйnйration du menu arboriforme sur la base ;; du catalogue avec les dwg-fichiers. Le catalogue peut ;; contenir les catalogues mis et les fichiers. ;; le Nom du point du POP-menu correspond au dernier nom ;; au chemin d'accиs vers le catalogue avec les fichiers du menu. ;; le Fichier du menu est crйй dans le catalogue, qui йtait indiquй ;; par l'utilisateur. C'est pourquoi il est nйcessaire d'avoir droit sur ;; l'enregistrement а ce catalogue. ;; le Bornage : ;; les Noms du catalogue, les sous-directoires et les dwg-fichiers ;; ne peuvent pas contenir les crochets. "[" "]" ;; ;; les Auteurs : ElpanovEvgeniy et Alexander Rivilis ;;------------------------------------------------- (defun C:M_DWG_GEN (/ f i flag_first dirbase mns_path) (vl-load-com) (setq i 1 flag_first t ) (setq dirbase (getenv "dir_base")) (setq dirbase (m_BrowseFolder)) (if dirbase (progn (setenv "dir_base" dirbase) (setq f (open (setq mns_path (strcat (m_bslash dirbase) (vl-filename-base dirbase ) ".mns" ) ) "w" ) ) (if f (progn (write-line (strcat "\n// Le menu de la base des blocs" "\n// Pour l'insertion au plan sans " "Les changements du montant" "\n***MENUGROUP=" (m_subst_blank (vl-filename-base dirbase ) ) "\n***POP1" "\n**" (m_subst_blank (vl-filename-base dirbase ) ) ) f ) (vl-catch-all-apply 'm_dir_base (list (vl-filename-base dirbase) (vl-filename-directory dirbase ) f ) ) (close f) (m_install_menu mns_path) ) ) ) ) (princ) ) ;;------------------------------------------------- ;; La fonction principale de la gйnйration du niveau du menu ;;------------------------------------------------- (defun m_dir_base (a p f / l_subdirs l_files n s_back i_back l n_dwg_sub ) (if (and a p f) (progn (setq i_back 0 n_dwg_sub 0 s_back "" ) (setq l_subdirs (m_Sort_Lex (cddr (vl-directory-files (strcat (m_bslash p) a) nil -1 ) ) ) ) (setq l_files (m_Sort_Lex (vl-directory-files (strcat (m_bslash p) a) "*.dwg" 1 ) ) ) (if (or l_subdirs l_files) (progn (cond (flag_first (write-line (strcat "ID_Mn" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base" ) ) ) (itoa (setq i (1+ i) ) ) ) "\t\t[" (m_subst_blank a) "]" "\n\t\t[&Enlever le menu " (m_subst_blank (vl-filename-base dirbase) ) "]_.menuunload " (m_subst_blank (vl-filename-base dirbase ) ) " " ) f ) (setq flag_first nil) ) (T (write-line (strcat "ID_Mn" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base" ) ) ) (itoa (setq i (1+ i) ) ) ) "\t\t[->" a "]" ) f ) (setq i_back (1+ i_back)) ) ) (foreach a1 l_subdirs (if (> (setq l (m_calc_dwg_files (strcat (m_bslash p) (m_bslash a) a1 ) ) ) 0 ) (progn (setq i_back (+ i_back (m_dir_base a1 (strcat (m_bslash p) (m_bslash a) ) f ) ) ) (setq n_dwg_sub (1+ n_dwg_sub)) ) ) ) (if (and l_subdirs l_files (> n_dwg_sub 0)) (progn (write-line (strcat "ID_" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base") ) ) (itoa (setq i (1+ i))) ) "\t\t[--];" ) f ) ) ) (cond (l_files (while l_files (write-line (strcat "ID_" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base") ) ) (itoa (setq i (1+ i))) ) "\t\t[" (if (> (length l_files) 1) "" (m_replicate_back i_back) ) (vl-filename-base (car l_files)) "]^C^C_.-insert \"" (m_subst_bslash (strcat (m_bslash p) (m_bslash a) (car l_files) ) ) "\" _s 1 " ) f ) (setq l_files (cdr l_files)) ) (setq i_back 0) ) (T (write-line (strcat "ID_" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base") ) ) (itoa (setq i (1+ i))) ) "\t\t[" (m_replicate_back i_back) "--];" ) f ) (setq i_back 0) ) ) ) ) ) ) i_back ) ;;------------------------------------------------- ;; La fonction pour le choix du catalogue ;;------------------------------------------------- (defun m_BrowseFolder (/ ShlObj Folder FldObj OutVal) (vl-load-com) (setq ShlObj (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ) Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 0) ) (vlax-release-object ShlObj) (if Folder (progn (setq FldObj (vlax-get-property Folder 'Self) OutVal (vlax-get-property FldObj 'Path) ) (vlax-release-object Folder) (vlax-release-object FldObj) OutVal ) ) ) ;;------------------------------------------------- ;; La fonction multiplie "<-" le nombre donnй de la fois. ;;------------------------------------------------- (defun m_replicate_back (n / s) (setq s "") (repeat n (setq s (strcat s "<-"))) s ) ;;-------------------------------------------------- ;; La fonction calcule la quantitй dwg - les fichiers dans cela ;; le catalogue et dans tous les catalogues mis dans lui. ;;------------------------------------------------- (defun m_calc_dwg_files (path / n) (setq n (length (vl-directory-files (m_bslash path) "*.dwg" 1 ) ) ) (foreach d (cddr (vl-directory-files path nil -1) ) (setq n (+ n (m_calc_dwg_files (strcat (m_bslash path) d ) ) ) ) ) n ) ;;------------------------------------------------- ;; La fonction ajoute а la ligne "\" s'il n'йtait pas. ;;------------------------------------------------- (defun m_bslash (p) (if (/= (substr p (strlen p) 1) "\\") (strcat p "\\") p ) ) ;;------------------------------------------------- ;; la Fonction pour le remplacement dans la ligne de toutes les lacunes et ;; des crochets pour les soulignements. "_" ;;------------------------------------------------- (defun m_subst_blank (s) (vl-string-translate " []" "___" s) ) ;;------------------------------------------------- ;; la Fonction pour le remplacement dans la ligne de tous "\" sur "/". ;;------------------------------------------------- (defun m_subst_bslash (s) (vl-string-translate "\\" "/" s) ) ;;------------------------------------------------- ;; la Fonction charge le menu ;; ajoute а la queue POP - le menu nouveau ;; le point, avec le dernier nom du nom du catalogue. ;;------------------------------------------------- (defun m_install_menu (mns_path) (if (menugroup (m_subst_blank (vl-filename-base (getenv "dir_base") ) ) ) (progn (vl-cmdf "_.menuunload" (strcat (m_subst_blank (vl-filename-base (getenv "dir_base") ) ) ) ) (vl-cmdf "_.menuload" mns_path) (menucmd (m_subst_blank (strcat "P99=+" (vl-filename-base (getenv "dir_base")) "." (vl-filename-base (getenv "dir_base")) ) ) ) ) (progn (vl-cmdf "_.menuload" mns_path) (menucmd (m_subst_blank (strcat "P99=+" (vl-filename-base (getenv "dir_base")) "." (vl-filename-base (getenv "dir_base")) ) ) ) ) ) ) ;;------------------------------------------------- ;; la Fonction du tri de la liste des lignes а lexicographique ;; l'ordre en dehors de la dйpendance du registre. ;;------------------------------------------------- (defun m_Sort_Lex (list_string) (vl-sort list_string '(lambda (s1 s2 / n) (setq n (- (strlen s1) (strlen s2))) (cond ((< n 0) (repeat n (setq s1 (strcat s1 " "))) ) ((> n 0) (repeat n (setq s2 (strcat s2 " "))) ) ) (< (strcase s1) (strcase s2)) ) ) )

Chez vous le trиs bon site! Je suis content que je peux le lire :) On regrette, mais je ne vous peux pas aider.... Moi seulement le lecteur. :(

Je regrette beaucoup. Je ne connais pas du tout le Franзais la langue, mais j'en utilisant le compilateur non je comprends exactement les questions... PS. Je ne me passionne pas récursivité, je les utilise а l'йgal de n'importe quels autres programmes, je compile seulement а part (sans optimalisation).

(entmakex '((0 . "MTEXT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "Kb_") (100 . "AcDbMText") (10 0. 0. 0.0) (40 . 0.2) (41 . 24.4136) (46 . 0.0) (71 . 1) (72 . 5) (1 . "\\pt5;{\\H15x;\\C1;E\\C3;l\\fArial Black|b0|i0|c0|p34;\\C256;p\\fArial Narrow|b0|i0|c0|p34;a\\fArial|b0|i0|c204|p34;\\C5;n\\H1.167x;ov\\fTimes New Roman|b0|i0|c204|p18;\\H0.8571x;\\C256;Evgeni\\H1.167x;y}" ) (7 . "Standard") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 30.7032) (43 . 4.61776) (50 . 0.0) (73 . 1) (44 . 1.0) ) )

>(defun randnum ... :) http://www.afralisp.net/Tips/code104.htm http://intervision.hjem.wanadoo.dk/lisps/randnum.lsp

(cdr (assoc -1 (entget (ssname sel x)))) = (ssname sel x)

Si A et B les cathètes C - l'hypoténuse ( ATAN A B) PS: Si je n'ai pas compris la question, montre s'il vous plaît le tableau...

Bonjour. Utilise la fonction ATAN

(defun 3d-pt (lst) (if lst (cons (list (car lst) (cadr lst)(caddr lst)) (3d-pt (cdddr lst))) ) ;_ if ) (3d-pt '("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l")) ; => (("a" "b" "c") ("d" "e" "f") ("g" "h" "i") ("j" "k" "l"))

Probablement, j'ai compris mal la tâche... :exclam: L'exemple du travail avec la liste, comme avec le texte (substr string start [length]) (test liste start length) (defun test (lst s e) (if (> s 1) (test (cdr lst) (1- s) e) (if (and lst (or (not e)(> e 0))) (cons (car lst) (test (cdr lst) s (if e(1- e)))) ) ;_ if ) ;_ if ) ;_ defun ;; Le test (test '("a" "b" "c" "d" "e" "f") 1 nil);=>("a" "b" "c" "d" "e" "f") (test '("a" "b" "c" "d" "e" "f") 3 nil);=>("c" "d" "e" "f") (test '("a" "b" "c" "d" "e" "f") 1 3);=>("a" "b" "c") (test '("a" "b" "c" "d" "e" "f") 3 2);=>("c" "d")

(princ (apply(function +) '(1.414 1.414 2.285))) (princ) [Edité le 31/10/2006 par ElpanovEvgeniy]

:exclam: M'excusez! Probablement, je non ai compris exactement la tвche... Votre code travaille exactement!

(acet-ui-message "The body text" "Header" 64 ) Base types 0 = Acet:OK 1 = Acet:OKCANCEL 2 = Acet:ABORTRETRYIGNORE 3 = Acet:YESNOCANCEL 4 = Acet:YESNO 5 = Acet:RETRYCANCEL Icons 16 = Acet:ICONSTOP 32 = Acet:ICONQUESTION 48 = Acet:ICONWARNING 64 = Acet:ICONINFORMATION Default buttons 0 = Acet:DEFBUTTON1 256 = Acet:DEFBUTTON2 512 = Acet:DEFBUTTON3 768 = Acet:DEFBUTTON4 Return Values 1 = Acet:IDOK 2 = Acet:IDCANCEL 3 = Acet:IDABORT 4 = Acet:IDRETRY 5 = Acet:IDIGNORE 6 = Acet:IDYES 7 = Acet:IDNO 8 = Acet:IDCLOSE 9 = Acet:IDHELP

Probablement, vous pensiez, je jamais n'apprends pas cela ? :)