gile

Il me semble que REVDATE ne fonctionne que sur LT. Si tu dispose d'une version "pleine" tu peux faire Insertion -> Champs... et choisir DateEnregistrement ou DateTracé et la date dans le champs se remet automatiquement à jour à chaque enregistrement ou à chaque tracé

Oups ! ... Je n'avais pas tout bien vérifié, le calcul pour l'élévation ne fonctionnait pas dans tous les cas. Voilà le nouveau code : (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (1) (cons 38 (- (caddr pt1) (caddr (trans '(0 0) 0 1)))) (cons 10 (trans pt1 1 (extr_dir))) (cons 10 (trans pt2 1 (extr_dir))) (cons 10 (trans pt3 1 (extr_dir))) (cons 10 (trans pt4 1 (extr_dir))) (cons 210 (extr_dir)) ) ) ) Toujours avec (extr_dir) et les coordonnées de pt1, pt2, pt3, pt4 dans le SCU courant.

Personnellement, je ne l'ai jamais fait. Je suis nouveau sur le site et plutôt nul avec internet. Je crois que tu peux trouver des explications dans Menu principal -> Support -> CADxp, le site Je viens d'y apprendre comment faire un lien.

A propos du début de la discussion (avantages et incovénients des méthodes entmake et command), une entité créée avec entmake n'est pas enregistrée par "undo", donc si on fait un undo après une expression LISP utilisant entmake on annule la commande précédent cette expression (à moins qu'il y ait un paramétrage que je ne connais pas). Sinon, j'ai eu pas mal de difficultés à faire une lwpolyline avec entmake dans un SCU différent du SCG (en 3D). Alors, pour ceux que çà intéresse, ce code semble marcher dans tous les cas : (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) ; nombre de sommets '(70 . 1) ; ouverte (0) ou fermée (1) (cons 38 (caddr (trans '(0 0) 1 (extr_dir)))) ; élévation (cons 10 (trans pt1 1 (extr_dir))) (cons 10 (trans pt4 1 (extr_dir))) (cons 10 (trans pt2 1 (extr_dir))) (cons 10 (trans pt3 1 (extr_dir))) (cons 210 (extr_dir)) ; direction d'extrusion ) ) Pour la direction d'extrusion : (defun extr_dir (/ vec org) (setq vec (trans '(0 0 1) 1 0) org (trans '(0 0 0) 1 0); (getvar "ucsorg") ) (list (- (car vec) (car org)) (- (cadr vec) (cadr org)) (- (caddr vec) (caddr org)) ) )

Avant de découvrir qu'elles exitaient en vlisp, j'ai trouvé certaines fonction équivalentes dans la FAQ Autolisp de Reini Urban (CF le site @CAD+, je ne sais pas faire de lien) et pour essayer de comprendre ce qu'est la récursivité, j'en ai commis moi même quelques que je livre ici si çà peut intéressser des utilisateurs qui n'ont pas accés à vlisp (intellicad ,...) Les deux premières sont définies de deux façons : itérative et récursive. Les deux dernières sont piquées à la FAQ AutoLISP et nécessaire aux précédentes. ;;; Évalue si au moins un des membres d'une liste retourne T comme résultat à l'exécution d'une fonction ;;; (SOME 'minusp '(10 20 -50)) -> T ;;; En vlisp -> vl-some ;;; ;;; Façon itérative : (defun SOME (fun lst) (and (consp lst) (member T (mapcar fun lst)) ) ) ;;; Ou façon récursive : (defun SOME (fun lst) (cond ((null lst) nil) ((apply fun (list (car lst))) T) (T (SOME fun (cdr lst))) ) ) ;;; Vérifie si tous les membres d'une liste retournent T comme résultat à l'exécution d'une fonction ;;; (EVERY numberp '(10 5.5 0)) -> T ;;; En vlisp -> vl-every ;;; ;;; Façon itérative : (defun EVERY (fun lst) (and (consp lst) (apply '= (cons T (mapcar fun lst))) ) ) ;;; Façon récursive : (defun EVERY (fun lst) (cond ((null lst) nil) ((null (cdr lst)) (apply fun (list (car lst)))) ((apply fun (list (car lst))) (EVERY fun (cdr lst))) ) ) ;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste (defun REMOVE_DOUBLES (lst) (cond ((atom lst) lst) (T (cons (car lst) (REMOVE_DOUBLES (remove (car lst) lst))) ) ) ) ;;; une liste non vide ? ;;; En vlisp -> vl-consp (defun consp (x) (and x (listp x)) ) ;;; Enlève un article d'une liste (les éléments en doubles sont permis) ;;; (remove 0 '(0 1 2 3 0)) -> (1 2 3) ;;; En vlisp -> vl-remove (defun remove (ele lst) (apply 'append (subst nil (list ele) (mapcar 'list lst))) )

Pour synthétiser tout çà, on doit pouvoir faire 3 sous-fonctions qui serviraient pour toutes les routines qui utilisent un groupe undo et/ou modifient la valeurs de variables système. Elles pourraient être de genre : (defun MON_ERREUR (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (command) (REST_ENV) (princ) ) (defun SAVE_ENV (lst) (vl-load-com) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setq m:err *error* *error* MON_ERREUR varlist (mapcar '(lambda (x) (cons x (getvar x))) lst) ) ) (defun REST_ENV () (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (foreach pair varlist (if (/= (getvar (car pair)) (eval (cdr pair))) (setvar (car pair) (eval (cdr pair))) ) ) (setq *error* m:err m:err nil varlist nil ) ) Si elles sont accessible pour AutoCAD (dans un fichier *.mns par exemple) elle peuvent être appelées dans toute autre routine en allégeant notablement son code, par exemple : (defun C:MA_FONCTION (...) (SAVE_ENV '("cmdecho" "osmode")) ... La routine avec des appels de la fonction command et les changements de valeur de cmdecho et osmode ... (REST_ENV) (princ) ) Merci à Patrick_35 et Tramber, à plus...

C'est çà, maintenant çà marche, j'avais oublié (vl-load-com), et des guillemets aussi ! Ces deux fonctions gèrent le groupe undo de manière "silencieuse". Mais la méthode semble partager le même défaut (à mon avis) que la fonction ai_setCmdEcho qui est d'être incompatible avec d'autre logiciel qu'AutoCAD.

Merci Patrick_35, Jusque là j'avais fait l'impasse sur les fonctions vlisp, donc je ne sais pas m'en servir ! J'ai testé, et j'ai eu le message d'erreur sivant : ; erreur: no function definition: VLAX-GET-ACAD-OBJECT Pour être sûr de se comprendre voilà la copie du test : (defun c:test (/ old_echo pt1 ray) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setq old_echo (getvar cmdecho) pt1 (getpoint "\nSpécifiez le premier centre: ") ray (getpoint pt1 "\nSpécifiez le rayon: ") ) (setvar "cmdecho" 0) (command "_circle" pt1 ray) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setvar "cmdecho" old_echo) (princ) )

Merci encore, Tramber. Je procède en général à peu près comme dans l'exemple, ouverture du groupe undo, puis changement de la valeur des variables système (CF routine envoyée hier), mais de cette manière un echo est renvoyé pour le premier appel de la fonction command, à savoir (command "_undo" "__begin") ou autre ... ... et çà fait pas propre !

Existe-t-il des alternatives à ai_setCmdEcho (trouvé dans ai_utils.lsp de AutoCAD) et qui semble ne fonctionner que dans AutoCAD et seulement depuis la version 2004. Mon problème est de ne pas perdre la restauration à sa valeur initiale de la variable cmdecho aprés avoir annuler une routine LISP. Peut-on constituer un groupe undo sans passer par command et changer cmdecho ensuite ? Autres questions, ai_setCmdEcho utilise la variable environnement "acedChangeCmdEchoWithoutUndo". Où peut-on trouver la liste de ces variables ? Peut-on les utiliser comme des variables système, ou est-ce imprudent ?

Super, je vais apprendre un nouvelle fonction. Là comme çà, je ne vois pas immédiatement l'intérêt pour le code ci-dessus, mais je vais creuser la question. En tous cas, merci encore !

Merci Tramber Mon anglais est vraiment trop pauvre, je ne comprend pas l'utilté de la fonction grread ni comment elle fonctionne. Est-ce que tu suggère de l'utiliser à la place de getangle ?

L'option largeur est accessible en tapant "enter" au lieu de spécifier le premier point. Pour les angles, il faut les specifier en degrés ou directement avec le pointeur.

Autodidacte et débutant en AutoLISP je soumets cette routine à la critique. Tous les commentaires sont évidemmment les bienvenus. ;;; 20/04/05 Fonction TRAPEZE - Gilles Chanteau - ;;; ;;; c:trapeze Crée une polyligne fermée décrivant un quadrilatère trapézoïdal. ;;; Permet à l'utilisateur de spécifier la largeur entre les deux côtés parallèles (hauteur du trapèze). ;;; Demande respectivement pour chacun des autres côtés, un point à un des sommets (indifféremment ;;; sur l'une ou l'autre base) et, à ce sommet, l'angle formé par ce côté avec l'axe des X. ;;; Cette fonction a été créée pour tracer les pièces rectilignes dont les coupes en bout ne sont ;;; pas d'équerre (écharpes, jambes de force, goussets et autres "diagos") utilisées en menuiserie, ;;; charpente, serrurerie... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; TRAPEZE_ERR Redéfinition de *error* ;;; ferme le groupe "UNDO" et restaure la valeur initiale des variables. (defun TRAPEZE_ERR (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (command "_undo" "_end") (rest_var) (setq *error* m:err m:err nil ) (princ) ) ;;; TRPZ_ERR - Envoie un message explicatif et quitte l'application. (defun TRPZ_ERR (msg) (princ (strcat "\nErreur: " msg)) (exit) ) ;;; EQUALKPI - Évalue si un angle est égal à k pi radians à 0.000000001 près. (defun EQUALKPI (ang) (or (equal (rem ang pi) 0 1e-009) (equal (abs (rem ang pi)) pi 1e-009) ) ) ;;; ACOS Retourne l'arc cosinus du nombre, en radians (defun ACOS (num) (if (<= -1 num 1) (atan (sqrt (- 1 (expt num 2))) num) (princ "\nErreur: L'argument pour ACOS doit être compris entre -1 et 1" ) ) ) ;;; REST_VAR & SAVE_VAR ;;; ;;; SAVE_VAR Enregistre la valeur initiale des variables système dans une liste associative (defun save_var (lst) (setq varlist (mapcar '(lambda (x) (cons x (getvar x))) lst)) ) ;;; REST_VAR Restaure leurs valeurs initiales aux variables système de la liste SAVE_VAR (defun rest_var () (foreach pair varlist (if (/= (getvar (car pair)) (eval (cdr pair))) (setvar (car pair) (eval (cdr pair))) ) ) (setq varlist nil) ) ;;; C:TRAPEZE - Fonction principale (defun c:trapeze (/ pt1 pt2 pt3 pt4 a0 a1 a2 a3 a4 alpha) (setq m:err *error* *error* TRAPEZE_ERR ) (save_var '("orthomode" "cmdecho" "osmode")) (command "_undo" "_begin") (setvar "orthomode" 0) (setvar "cmdecho" 0) (princ "trapeze") ;; Saisie des données (if (not (numberp *larg*)) (setq *larg* 10) ) (while (not (setq pt1 (getpoint (strcat "\nLa largeur courante est de " (rtos *larg*) "\nSpécifiez le premier sommet ou <Largeur>: " ) ) ) ) (initget 6) (setq *larg* (getdist "\nSpécifiez la largeur: ")) ) (setq a1 (getangle pt1 "\nSpécifiez l'angle décrit par ce côté: ")) (initget 1) (setq pt2 (getpoint pt1 "\nSpécifiez le second sommet: ")) (if (not (equal (caddr pt1) (caddr pt2) 1e-009)) (TRPZ_ERR "les sommets ne sont pas dans un plan parallèle au SCU courant." ) ) (setq a2 (getangle pt2 "\nSpécifiez l'angle décrit par ce côté: ")) ;; Conversion des données (setq a0 (angle pt1 pt2) pt3 (polar pt1 a1 *larg*) pt4 (polar pt2 a2 *larg*) ) (foreach n '(a1 a2) (set n (- (eval n) a0)) (if (minusp (eval n)) (set n (+ (eval n) (* 2 pi))) ) (if (EQUALKPI (eval n)) (TRPZ_ERR "un des côtés est aligné avec les sommets.") ) ) (setvar "osmode" 0) ;; Évaluation de la position des côtés par rapport aux deux sommets spécifiés (if (or (and (< 0 a1 pi) (< 0 a2 pi)) (and (< pi a1 (* 2 pi)) (< pi a2 (* 2 pi))) ) ;; Calcul des autres sommets si les premiers sont situés sur une base du trapèze (setq pt3 (polar pt1 (+ a0 a1) (/ *larg* (abs (sin a1)))) pt4 pt2 pt2 (polar pt2 (+ a0 a2) (/ *larg* (abs (sin a2)))) ) ;; Calcul des autres sommets si les premiers sont situés sur une diagonale du trapèze (if (> *larg* (distance pt1 pt2)) (TRPZ_ERR "la largeur est plus grande que la diagonale.") (progn (setq alpha (ACOS (/ *larg* (distance pt1 pt2)))) (if (< a1 pi) (setq a3 (- alpha a1) a4 (- alpha a2 pi) ) (setq a3 (+ alpha a1) a4 (+ alpha a2 pi) ) ) (foreach n (list a3 a4) (if (equal (cos n) 0 1e-009) (TRPZ_ERR "un des côtés est aligné avec une des bases.") ) ) (setq pt3 (polar pt1 (+ a0 a1) (/ *larg* (cos a3))) pt4 (polar pt2 (+ a0 a2) (/ *larg* (cos a4))) ) ) ) ) ;; Création de la polyligne, si les données le permettent (if (inters pt1 pt3 pt2 pt4 T) (TRPZ_ERR "intersection des côtés (polygone croisé).") (command "_pline" pt1 pt3 pt2 pt4 "_c") ) (command "_undo" "_end") (rest_var) (setq *error* m:err m:err nil ) (princ) )