(gile)

Le sujet a souvent été abordé, la variable qui t'intéresse est PSLTSCALE. Tu peux aller voir ici. Ou faire une recherche avec LTSCALE ou PSLTSCALE J'ai encore été un peu lent :cool: [Edité le 24/1/2006 par (gile)]

Je tente une autre réponse (un peu laborieuse) : Pour chaque sphère, dans les propriétés, on récupère les coordonnées du sommet 1, et celles du sommet à l'index égal aux nombre de segments latitudinaux + 1. Ce sont les "poles" de la sphère seule leur coordonnées Z est différente. La somme des deux Z est le Z du centre de la sphère, la différence des deux Z est le diamètre de la sphère. On trace les lignes avec les coordonnées des centres et on les ajuste avec MODIFLONG -> DIfférence -> - le rayon de la sphère.

Le vérouiller ?

Pour Boris : Commme l'on dit Concombre-masque et Ludwig la perpendiculaire au milieu d'une corde ou à la tangente au point de tangence est un rayon du cercle, par extension on peut considérer (et AutoCAD le fait) que la perpendiculaire à un cercle ou un arc en un point estla droite contenant le rayon en ce point. Pour Tramber : C'est tricher MEE et DEE avec la calculatrice ?

À l'aide de la calculatrice géométrique d'AutoCAD. Copie de la fenêtre Autocad (F2) : [Edité le 23/1/2006 par (gile)]

Effectivement, dans le commerce, je n'en ai jamais vu que pour les métallos et de petite taille. J'ai fabriqué ma première "équerre à centrer les ronds" à l'époque où je faisais du tournage sur bois (pour re-centrer les pièces déjà tournées) depuis j'ai été amené à en fabriquer d'autres de plus grande taille (environ 400 mm de long) en contre-plaqué, pour tracer des rayons sur des cerces de feuilles décor. La difficulté réside essentiellement dans la précision du positionnement des goujons qui doivent être sur une perpendiculaire à l'axe et strictement à égale distance de cet axe.

On l'appelle aussi équerre à tracer les rayons. Les rayons étant perpendiculaires au milieu des cordes. Elle sert sur tout les cercles ou arcs et fonctionne aussi sur les parties concaves. Çà ressemble à çà (en noir, avec 2 goujons à la place des points): http://img206.imageshack.us/img206/6408/centrer4wb.jpg [Edité le 23/1/2006 par (gile)]

Çà me rassure de voir que je ne suis pas seul à m'amuser à me mélanger les neurones. ;)

Salut, Il y a LTBooster ici, en anglais, mais qui a l'air bien aussi. Il est dit qu'il est compatible pour la plupart des fonctions vla- vlx- et vlr- de quoi faire plus que des petits LISP ! Sinon, si LT-extender ne reconnaît pas les fonctions vl- d'AutoCAD, j'ai commencé à poster ici des routines équivalentes à certaines de ces fonctions dont certaines sont, à mon avis, fort utiles pour la manipulation des listes et des chaines.

J'ai ajouté à la liste du début trois nouvelles fonctions équivalentes à des vl-* et une routine REMOVE_DOUBLES qui n'a pas d'équivalent vl-* mais qui est pourtant parfois bien utile.

Salut, Dessiner en 3D j'imagine. En surfacique, avec la commande Surface de révolution En solide, avec la commande Révolution

J'ai dit : " Équivalences à vl-* " pas à vla- ou vlax- ! ;)

Rendons à César ... Cette merveille de concision n'est pas de moi, elle provient de la Faq AutoLISP et y est attribuée à Serge Volkov (que personnellement, je n'ai pas l'honneur de connaître). Dans cette première liste, je n'ai commis que : EVERY, LIST->STRING, MEMBER-IF, MEMBER-IF-NOT, SOME etSTRING->LIST. Mais je compte bien essayer de l'allonger. ;)

Pour ceux qui utilisent les logiciels Intellidesk, Intellicad... ou LT extender et qui n'ont pas les fonctions vl-*, je me suis essayé à faire des équivalences pour certaines de ces fonctions. Certaines sont piquées dans la faq AutoLISP de Reini Urban, les autres sont de mon cru. ;;; CONSP (vl-consp) ;;; Détermine si une liste est vide ou non ;;; (consp '()) -> nil (consp '(1 2 3)) -> T (defun consp (lst) (and lst (listp lst)) ) ;;;**************************************************************** ;;; EVERY (vl-every) mais pour une seule liste ;;; Évalue si tous les membres d'une liste retournent T ;;; comme résultat à l'exécution d'une fonction test ;;; (every 'numberp '(1 2 3)) -> T (defun every (fun lst) (apply '= (cons T (mapcar fun lst))) ) ;;;**************************************************************** ;; FILE-DIRECTOTRY-P (vl-file-directory-p) ;; Évalue si le nom de fichier fait référence à un répertoire ;; ;; Argument : ;; filename : chaine de caractère, le nom du fichier avec son chemin complet. ;; ;; Exemples ;; ;; (file-directory-p "C:/Program Files/AutoCAD 2007") -> T ;; (file-directory-p "C:/Program Files/AutoCAD 2007/acad.exe") -> nil (defun file-directory-p (filename / file) (and (findfile (string-right-trim "\\/" filename)) (if (setq file (open filename "r")) (close file) T ) ) ) ;;;**************************************************************** ;; FILENAME-BASE (vl-filename-base) ;; Retourne le nom du fichier sans l'extension ni le chemin ;; Ne vérifie pas l'existence de fichier ;; ;; Argument: ;; filename : chaine de caractère, le nom du fichier avec son chemin complet ;; ;; Exemples ;; ;; (filename-base "c:\\acadwin\\acad.exe") -> "acad" ;; (filename-base "c:\\acadwin") -> "acadwin" (defun filename-base (filename) ((lambda (n) (substr n 1 (string-position (ascii ".") n 0 T)) ) (substr filename (+ 2 (strlen (filename-directory filename))) ) ) ) ;;;**************************************************************** ;; FILENAME-DIRECTORY (vl-filename-directory) ;; Retourne le chemin du répertoire d'un fichier sans le nom de fichier ni l'extension ;; ;; Argument: ;; filename : chaine de caractère, le nom du fichier avec son chemin complet ;; ;; Exemples ;; ;; (filename-directory "c:\\acadwin\\acad.exe") -> "c:\\acadwin" ;; (filename-directory "acad.exe") -> "" (defun filename-directory (filename) (substr filename 1 (max (cond ((string-position (ascii "/") filename 0 T)) (0) ) (cond ((string-position (ascii "\\") filename 0 T)) (0) ) ) ) ) ;;;**************************************************************** ;; FILENAME-EXTENSION (vl-filename-extension) ;; Retourne l'extension d'un fichier ;; ;; Argument: ;; filename : chaine de caractère, le nom du fichier avec son chemin complet ;; ;; Exemples ;; ;; (filename-extension "c:\\acadwin\\acad.exe") -> ".exe" ;; (filename-extension "c:\\acadwin\\acad") -> nil (defun filename-extension (filename / pos) (if (setq pos (string-position (ascii ".") (substr filename (+ 2 (strlen (filename-directory filename))) ) 0 T ) ) (substr filename (1+ pos)) ) ) ;;;**************************************************************** ;; filename-mktemp ;; Tentative de fonction équivalente à vl-filename-mktemp pour les logiciels ;; ou applications qui n'ont pas de fonctions vl-* ;; ;; Calcule un nom de fichier unique pour être utilisé comme fichier temporaire ;; ;; Arguments : ;; - nom : chaine de caractères, le modèle du nom du fichier ou nil. ;; Si nil : $VL~~ est utilisé ;; ;; - rep : chaine de caractères, le chemin du dossier ou nil. ;; Si nil : un répertoire est choisit dans l'ordre suivant : ;; - le répertoire spécifié dans la variable d'environnement TMP ;; - le répertoire spécifié dans la variable d'environnement TEMP ;; - le répertoire courant (variable système DWGPREFIX) ;; ;; - ext : chaine de caractères, l'extension du fichier ou nil ;; Si nil : extension spécifiée dans l'argument nom (peut être une chaine vide) ;; ;; Retour ;; Une chaine de caractère qui contient le chemin et le nom du fichier du style : ;; Chemin_du_répertoire\basexxx.extension ;; où base est constitué au plus des 5 premiers caractères de l'argument nom ;; et xxx une chaine hexadécimale incrémentée. ;; ;; Exemples : ;; ;; (filename-mktemp nil nil nil) -> "C:\\DOCUME~1\\XXX~1\\LOCALS~1\\Temp\\$VL~~001" ;; (filename-mktemp nil nil ".txt") -> "C:\\DOCUME~1\\XXX~1\\LOCALS~1\\Temp\\$VL~~002.txt" ;; (filename-mktemp "temporaire.txt" nil nil) -> "C:\\DOCUME~1\\XXX~1\\LOCALS~1\\Temp\\tempo003.txt" ;; (filename-mktemp "temporaire" "C:" ".txt") -> "C:\\tempo004.txt" ;; ;; NOTA : Cette routine utilise HEX de Patrick_35 (defun filename-mktemp (nom rep ext / str pos) (if *mktempinc* (setq *mktempinc* (1+ *mktempinc*)) (setq *mktempinc* 1) ) (and nom (setq pos (string-position (ascii ".") nom nil T))) (and rep (setq rep (string-right-trim "\\/" rep))) (setq ext (cond (ext) (pos (substr nom (1+ pos))) ("") ) nom (if nom (if pos (substr nom 1 (min 5 pos)) (substr nom 1 5) ) "$VL~~" ) rep (cond ((and rep (not (filename-extension rep)) (findfile rep) ) rep ) ((getenv "TMP")) ((getenv "TEMP")) ((getvar "DWGPREFIX")) ) ) (while (findfile (setq str (strcat rep "\\" nom ((lambda (x) (cond ((= (strlen x) 1) (strcat "00" x)) ((= (strlen x) 2) (strcat "0" x)) (x) ) ) (hex *mktempinc*) ) ext ) ) ) (setq *mktempinc* (1+ *mktempinc*)) ) str ) ;; HEX Patrick_35 ;; convertit un entier en hexadécimal (defun hex (n / r i) (setq r "") (while (> n 0) (setq i (rem n 16) n (lsh n -4) r (strcat (if (< i 10) (itoa i) (chr (+ 55 i)) ) r ) ) ) ) ;;;**************************************************************** ;;; LIST->STRING (vl-list->string) ;;; Transforme une liste d'entiers (caractères ASCII) en une chaine ;;; (list->string '(49 50)) -> "12" (defun list->string (lst / err) (apply 'strcat (mapcar 'chr lst)) ) ;;;**************************************************************** ;;; MEMBER-IF (vl-member-if) ;;; Au premier élément de la liste retournant T à l'exécution d'une fonction ;;; test, retourne la liste constituée de cet élément et des suivants ;;; (member-if 'numberp '("str" 1 nil)) -> (1 nil) (defun member-if (fun lst) (cond ((null lst) nil) ((apply fun (list (car lst))) lst) (T (member-if fun (cdr lst))) ) ) ;;;**************************************************************** ;;; MEMBER-IF-NOT (vl-member-if-not) ;;; Au premier élément de la liste retournant nil à l'exécution d'une ;;; fonction test, retourne la liste constituée de cet élément et des suivants ;;; (member-if-not 'stringp '("str" 1 nil)) -> (1 nil) (defun member-if-not (fun lst) (while (apply fun (list (car lst))) (setq lst (cdr lst)) ) lst ) ;;;**************************************************************** ;;; POSITION (vl-position) ;;; Retourne l'index du premier élément dans la liste ;;; (position 'b '(a b c d)) -> 1 (defun position (ele lst / ret) (if (not (zerop (setq ret (length (member ele lst))) ) ) (- (length lst) ret) ) ) ;;;**************************************************************** ;;; PRIN1-TO-STRING (vl-prin1-to-string) ;;; Retourne la chaine de caractère représentant la donnée LISP ;;; comme elle est retournée par le fonction prin1 ;;; (prin1-to-string "abc") -> "\"abc\"" ;;; (prin1-to-string "c:\\acadwin") -> "\"c:\\\\acadwin\"" ;;; (prin1-to-string 'my-var) -> "MY-VAR" (defun prin1-to-string (data / tmp file str) (setq tmp "$sym.tmp" file (open tmp "w")) (prin1 data file) (close file) (setq file (open tmp "r") str (read-line file) ) (close file) str ) ;;;**************************************************************** ;;; PRINC-TO-STRING (vl-princ-to-string) ;;; Retourne la chaine de caractère représentant la donnée LISP ;;; comme elle est retournée par le fonction princ ;;; (princ-to-string "abc") -> "abc" ;;; (princ-to-string "c:\\acadwin") -> "C:\\ACADWIN" ;;; (vl-princ-to-string 'my-var) -> "MY-VAR" (defun princ-to-string (data / tmp file str) (setq tmp "$sym.tmp" file (open tmp "w")) (princ data file) (close file) (setq file (open tmp "r") str (read-line file) ) (close file) str ) ;;;**************************************************************** ;;; REMOVE (vl-remove) ;;; Enlève un élément d'une liste ;;; (remove 0 '(0 1 2 3 0)) -> (1 2 3) (defun remove (ele lst) (apply 'append (subst nil (list ele) (mapcar 'list lst))) ) ;;;**************************************************************** ;;; REMOVE-DOUBLES (pas d'éqivalent vl-...) ;;; Suprime tous les doublons d'une liste ;;; (remove_doubles '(0 1 2 1 3 0)) -> (0 1 2 3) (defun remove-doubles (lst) (if lst (cons (car lst) (remove-doubles (vl-remove (car lst) lst))) ) ) ;;;**************************************************************** ;;; REMOVE-IF (vl-remove-if) ;;; Enlève les éléments d'une liste qui retournent T à ;;; l'exécution d'une fonction test ;;; (remove-if 'numberp '(0 (0 1) "str")) -> ((0 1) "") (defun remove-if (fun lst) (cond ((atom lst) lst) ((apply fun (list (car lst))) (remove-if fun (cdr lst))) (T (cons (car lst) (remove-if fun (cdr lst)))) ) ) ;;;**************************************************************** ;;; REMOVE-IF-NOT (vl-remove-if-not) ;;; Conserve les éléments d'une liste qui retournent T à ;;; l'exécution d'une fonction test ;;; (remove-if-not 'numberp '(0 (0 1) "str" 0.0)) -> (0 0.0) (defun remove-if-not (fun lst) (apply 'append (mapcar '(lambda (e) (if (apply fun (list e)) (list e) ) ) lst ) ) ) ;;;**************************************************************** ;;; SOME (vl-some) mais pour une seule liste ;;; Évalue si au moins un des membres d'une liste retourne T ;;; comme résultat à l'exécution d'une fonction test ;;; (SOME 'minusp '(10 20 -50)) -> T (defun SOME (fun lst) (if (member T (mapcar fun lst)) T ) ) ;;;**************************************************************** ;;; SORT (vl-sort) ;;; Trie les éléments d'une liste à l'aide d'une fonction de comparaison. ;;; Ne supprime pas les doublons. ;;; (sort '(3 2 1 3) '>) -> (3 3 2 1) ;;; (sort '("didier" "denis" "arthur") '<) ("arthur" "denis" "didier") (defun sort (lst fun / sort tmp) (defun merge (l1 l2) (if (and l1 l2) (if (fun (car l1) (car l2)) (cons (car l1) (merge (cdr l1) l2)) (cons (car l2) (merge l1 (cdr l2))) ) (if l1 l1 l2 ) ) ) (setq lst (mapcar 'list lst) fun (eval fun) ) (while (cdr lst) (setq tmp lst lst nil ) (while (cdr tmp) (setq lst (cons (merge (car tmp) (cadr tmp)) lst) tmp (cddr tmp) ) ) (and tmp (setq lst (cons (car tmp) lst))) ) (car lst) ) ;;;**************************************************************** ;;; STRING-ELT (vl-string-elt) ;;; Retourne le code ASCII du caractère situé à la position ;;; spécifiée (0 pour le premier caractère) ;;; (string-elt "chaine" 2) -> 97 (defun string-elt (str pos) (if (< pos (strlen str)) (nth pos (string->list str)) ) ) ;;;**************************************************************** ;;; STRING-LEFT-TRIM (vl-left-trim) ;;; Supprime les caractères spécifiés du début d'une chaine ;;; (string-left-trim "bra" "abracadabra") -> "cadabra" (defun string-left-trim (c_set str) (if (member (ascii (substr str 1 1)) (string->list c_set)) (while (string-position (ascii (substr str 1 1)) c_set nil nil) (setq str (substr str 2 (1- (strlen str)))) ) str ) ) ;;;**************************************************************** ;;; STRING->LIST (vl-string->list) ;;; Transforme une chaine de caractères en une liste de codes ;;; ASCCI correspondants ;;; (string->list "str") -> (115 116 114) (defun string->list2 (str) (if (/= str "") (cons (ascii (substr str 1 1)) (string->list (substr str 2)) ) ) ) ;| (defun string->list (str / n lst) (repeat (setq n (strlen str)) (setq lst (cons (ascii (substr str n 1)) lst) n (1- n) ) ) lst ) |; ;;;**************************************************************** ;;; STRING-MISMATCH (vl-string-mismatch) ;;; Retourne la longueur du préfixe commun de deux chaines ;;; pos1 : Départ de la recherche pour la chaine 1 (0 si nil) ;;; pos2 : Départ de la recherche pour la chaine 2 (0 si nil) ;;; ign : ignore la casse si non nil ;;; (string-mismatch "bric" "broc" nil nil nil) -> 2 ;;; (string-mismatch "abri" "broc" nil nil nil) -> 0 ;;; (string-mismatch "abri" "broc" 1 0 nil) -> 2 ;;; (string-mismatch "bric" "bRoc" nil nil nil) -> 1 ;;; (string-mismatch "bric" "bRoc" nil nil T) -> 2 (defun string-mismatch (str1 str2 pos1 pos2 ign / cnt) (if ign (setq str1 (strcase str1) str2 (strcase str2) ) ) (foreach n '(pos1 pos2) (if (not (eval n)) (set n 0) ) ) (setq cnt 1) (while (= (substr str1 (+ cnt pos1) 1) (substr str2 (+ cnt pos2) 1) ) (setq cnt (1+ cnt)) ) (1- cnt) ) ;;;**************************************************************** ;;; STRING-POSITION (vl-string-position) ;;; Retourne la position d'un caractère (code ASCII) dans une ;;; chaine (0 pour le premier caractère) ;;; start : position du départ de la recheche (0 si nil) ;;; from_end_p : si non nil, recherche depuis la fin ;;; (string-position (ascii "a") "caractère" nil nil) -> 1 ;;; (string-position (ascii "a") "caractère" 3 nil) -> 3 ;;; (string-position (ascii "r") "caractère" nil T) -> 7 (defun string-position (char str start from-end-p / lst) (if (not start) (setq start 0) ) (setq lst (string->list (substr str (1+ start) (- (strlen str) start)) ) ) (if (member char lst) (if from-end-p (- (strlen str) (position char (reverse lst)) 1) (+ start (position char lst)) ) ) ) ;;;**************************************************************** ;;; STRING-RIGHT-TRIM (vl-string-right-trim) ;;; Supprime les caractères spécifiés de la fin d'une chaine ;;; (string-right-trim "bra" "abracadabra") -> "abracad" (defun string-right-trim (c_set str) (if (member (ascii (substr str (strlen str) 1)) (string->list c_set) ) (while (string-position (ascii (substr str (strlen str) 1)) c_set nil nil ) (setq str (substr str 1 (1- (strlen str)))) ) str ) ) ;;;**************************************************************** ;;; STRING-SEARCH (vl-string-search) ;;; Retourne l'index du modèle dans une chaine ;;; start : position du départ de la recheche (0 si nil) ;;; (string-search "bra" "abracadabra" nil) -> 2 ;;; (string-search "rat" "caractère" nil) -> nil ;;; (string-search "bra" "abracadabra" 2) -> 8 (defun string-search (pat str start / rslt) (if (not start) (setq start 0) ) (while (and (< start (strlen str)) (not rslt) ) (setq start (1+ start)) (if (= (substr str start (strlen pat)) pat) (setq rslt (1- start)) ) ) rslt ) ;;;**************************************************************** ;;; STRING-SUBST (vl-string-subst) ;;; Recherche et remplace la première occurence d'une chaine ;;; par une autre dans une chaine ;;; start : position du départ de la recheche (0 si nil) ;;; (string-subst "plu" "bra" "abracadabra" nil) -> "aplucadabra" ;;; (string-subst "plu" "bra" "abracadabra" 2) -> "abracadaplu" (defun string-subst (new pat str start / pos) (if (setq pos (string-search pat str start)) (strcat (substr str 1 pos) new (substr str (+ 1 pos (strlen pat)) (- (strlen str) (strlen pat) pos) ) ) str ) ) ;;;**************************************************************** ;;; STRING-TRANSLATE (vl-string-trnslate) ;;; Remplace certains caractères d'une chaine par un jeu ;;; de caractères spécifié ;;; (string-translate "Pt" "Tp" "Patissier") ->"Tapissier" (defun string-translate (srce dest str / cnt pos) (repeat (setq cnt (strlen str)) (if (setq pos (string-position (ascii (substr str cnt 1)) srce nil nil) ) (if (< pos (strlen dest)) (setq str (strcat (substr str 1 (1- cnt)) (chr (string-elt dest pos)) (substr str (1+ cnt) (- (strlen str) cnt)) ) ) ) ) (setq cnt (1- cnt)) ) str ) ;;;**************************************************************** ;;; STRING-TRIM (vl-string-trim) ;;; Supprime les caractères spécifiés du début et de la fin d'une chaine ;;; (string-trim "bra" "abracadabra") -> "cad" (defun string-trim (c_set str) (string-right-trim c_set (string-left-trim c_set str)) ) ;;;**************************************************************** ;;; SYMBOL-NAME (vl-symbol-name) ;;; Retourne le nom d'un symbole sous forme de chaine (inverse de READ) ;;; (symbol-name 'x) -> "x" (defun symbol-name (sym / str) (setq str (princ-to-string sym)) (if (symbolp sym) str (progn (princ (strcat "\nErreur: type d'argument incorrect: symbolp " (cond ((= (type sym) 'INT) (itoa sym)) ((= (type sym) 'REAL) (rtos sym)) ((= (type sym) 'STR) (strcat "\"" sym "\"")) (T str) ) ) ) (princ) ) ) ) ;;;**************************************************************** ;;; SYMBOLP (vl-symblop) ;;; Evalue si un objet est un symbole ;;; (symbolp T) -> T ;;; (symbolp nil) -> nil ;;; (symbolp pi) -> nil ;;; (symbolp 'pi) -> T (defun symbolp (obj) (and obj (= (type obj) 'SYM)) ) Équivalences aux fonctions vlax-ldata-* qui permettent de stocker et de récupérer des données dans des dictionnaires attachés au dessin. Ces fonctions utilisent every et prin1-to-string définies ci-dessus ;; DICT-DATA-PUT (vlax-ldata-put) ;; ;; Stocke une donnée dans un dictionnaire ;; ;; Arguments : ;; dict : le nom du dictionnaire (chaine) ;; key : la clé du dictionnaire (chaine) ;; data : la donnée (chaine, entier réel ou liste) ;; ;; Exemples : ;; (dict-data-put "mon_dico" "txt" "test") -> "test" ;; (dict-data-put "mon_dico" "lst" '(1 2 3)) -> (1 2 3) ;; (dict-data-put "mon_dico" "num" 1) -> 1 (defun dict-data-put (dict key data) (if (and (snvalid dict) (snvalid key) (member (type data) '(ENAME LIST INT REAL STR)) (if (dictsearch (namedobjdict) dict) (setq dict (cdr (assoc -1 (dictsearch (namedobjdict) dict)))) (setq dict (dictadd (namedobjdict) dict (entmakex '((0 . "DICTIONARY") (100 . "AcDbDictionary"))) ) ) ) (if (dictsearch dict key) (entdel (cdr (assoc -1 (dictsearch dict key)))) T ) (dictadd dict key (entmakex (list '(0 . "XRECORD") '(100 . "AcDbXrecord") (cond ((and (= (type data) 'LIST) (< 1 (length data) 4) (every 'numberp data) ) (cons 10 data) ) ((= (type data) 'REAL) (cons 40 data)) ((= (type data) 'INT) (cons 70 data)) ((= (type data) 'ENAME) (cons 350 data)) (T (cons 300 (prin1-to-string data))) ) ) ) ) ) data ) ) ;; DICT-DATA-LIST (vlax-ldata-list) ;; ;; Liste les données d'un dictionnaire ;; Arguments : ;; dict : le nom du dictionnaire (chaine) ;; ;; Exemple : ;; (dict-data-list "mon_dico") -> (("lst" 1 2 3) ("num" . 1) ("txt" . "test")) (defun dict-data-list (dict / elst key val lst) (if (and (setq dict (dictsearch (namedobjdict) dict)) (setq elst (member (assoc 3 dict) dict)) ) (progn (while elst (setq key (cdar elst) val (last (dictsearch (cdr (assoc -1 dict)) key)) lst (cons (cons key (if (= 300 (car val)) (read (cdr val)) (cdr val) ) ) lst ) elst (cddr elst) ) ) (reverse lst) ) ) ) ;; DICT-DATA-DELETE (vlax-ldata-delete) ;; ;; Supprime une donnée d'un dictionnaire ;; Arguments : ;; dict : le nom du dictionnaire (chaine) ;; key : la clé du dictionnaire (chaine) ;; ;; Exemple : ;; (dict-data-delete "mon_dico" "lst") -> "test" (defun dict-data-delete (dict key) (and (setq dict (dictsearch (namedobjdict) dict)) (setq key (dictsearch (cdr (assoc -1 dict)) key)) (entdel (cdr (assoc -1 key))) ) ) ;; DICT-DATA-GET (vlax-ldata-get) ;; ;; Retrouve un donnée dans un dictionnaire ;; Arguments : ;; dict : le nom du dictionnaire (chaine) ;; key : la clé du dictionnaire (chaine) ;; ;; Exemples : ;; (dict-data-get "mon_dico" "txt") -> "test" ;; (dict-data-get "mon_dico" "num") -> 1 ;; (dict-data-get "mon_dico" "lst") -> nil (defun dict-data-get (dict key) (if (and (setq dict (dictsearch (namedobjdict) dict)) (setq key (dictsearch (cdr (assoc -1 dict)) key)) ) (if (= 300 (car (last key))) (read (cdr (last key))) (cdr (last key)) ) ) ) [Edité le 22/7/2008 par (gile)]

Un petit LISP vite fait : Il sélectionne toutes les cotes faites dans le style "Mètre" et passe celles qui sont inférieures à 1 dans le style "Centimètre" (Echelle de la mesure = 100.00 dans l'onglet Unités principales) (defun c:m2cm (/ ss compt ent e_lst) (setq ss (ssget "_X" '((0 . "DIMENSION") (3 . "[color=#990000]Mètre[/color]"))) cnt 0 ) (repeat (sslength ss) (setq ent (ssname ss cnt) e_lst (entget ent) ) (if ( (progn (setq e_lst (subst (cons 3 "[color=#990000]Centimètre[/color]") (assoc 3 e_lst) e_lst)) (entmod e_lst) (entupd ent) ) ) (setq cnt (1+ cnt)) ) (princ) ) NB Tu peux renommer les styles de cote dans le LISP Oups ! j'avais oublié qu'on est dans un forum LT, mais peut-être as-tu LT Extender ? [Edité le 21/1/2006 par (gile)]

Il y aurait peut-être un moyen en passant par de la programmation avec des reactors sur les actions de cotations qui, en fonction de la valeur de la cote utiliseraient un style de cote ou l'autre. Mais çà dépasse largement mes connaissance en LISP (peut-être Patrick_35 ?). Sinon je suis complètement d'accord avec Laurent et je travaille en millimètres même si certains élément peuvent parfois mesurer autour de 20 000 mm.

Entièrement d'accord, bien que j'ai lu quelque part dans un message sur ce site un exemple qui montrait un intérêt d'avoir CMDECHO à 1 (mais je ne le retrouve pas*). Pour ma part je préfère, dans mes LISP, stocker la valeur initiale dans une variable pour la restituer à la fin de façon à ne pas perturber les habitudes d'autres utilisateurs éventuels dudit code. Pour les commentaires, tu as raison je ne le fais pas (ou plus) assez souvent. * Je l'ai retrouvé, c'est là. [Edité le 21/1/2006 par (gile)]

Une vraie usine à gaz !!!! À laquelle je n'arrive décidement pas à m'habituer (je n'ai pourtant pas de si grandes habitudes avec AutoCAD). Quand je dois me servir de 2006 je désactive systématiquement la saisie dynamique !

Encore une piste : DYNPICOORDS à 1. Mais le plus simple est peut-être de désactiver la saisie dynamique DYNMODE à 0.

Salut Christian, J'ai un peu testé ton LISP, çà marche fort bien (même sur Intellidesk). J'ai juste une petite question, je ne comprends pas ce que tu fais avec CMDECHO ; pourquoi le désactives-tu à nouveau à la fin ? Un oubli ou une subtilité que je ne connais pas ?

Une autre piste : COORDS à 2 Excuse-moi, je ne me souviens plus comment j'avais fait mais j'avais réussi à avoir avec 2006 un comportement proche des versions antérieures en ce qui concerne les questions que tu soulèves.

De mémoire, je ne suis pas sûr et ne peux vérifier, mais essaye en mettant la variable INPUTHISTORYMODE à 7 (elle est à 15 par défaut).

Encore une petite amélioration aux deux routines. Comme avec ANGTOS et ANGTOF : - on peut spécifier le type d'unité pour STR2ANG (ou nil -> type courant) - on peut spécifier le type d'unité et/ou la précision pour ANG2STR (ou nil -> type courant) Les routines ont maintenant un comportement très similaire à ANGTOS et ANGTOF, tout en gardant leurs spécificités : - non prise en compte des variables ANGDIR et ANGBASE - pris en compte des angles supérieurs ou égaux à un tour (sauf avec les unités géodésiques, bien sûr)

AutoCAD 2006 reconnaît le LISP, vois peut-être plutôt du côté de la méthode de chargement des routines.

Salut CADarome, Je suis au regret de te dire que çà ne marche pas mieux, j'ai fait un essai. Si l'extrémité d'un objet et située aux alentours de 100 unités (verticalement ou horizontalement) du point spécifié et si l'accrochage aux extrémités est actif le point calculé avec (polar p1 0 100) ou (polar p1 (* pi (/ 90 180.0)) 100)) sera "aimanté" par l'accrochage à l'extrémité (ceci en fonction de APERTURE comme dit plus haut). Comme le rappelle, par exemple Bonuscad ici , seule l'utilisation de entmake (je rajouterais les fonctions VisualLISP, mais çà n'est peut-être pas le propos ici) ne nécessite pas la précaution consistant à désactiver les accrochages aux objets. PS : (* pi (/ 90 180.0)) peut s'écrire aussi (* pi (/ 90 (- 360 180))) mais (/ pi 2) est plus simple ;) Amicalement.