zebulon_

Bonjour, J'utilise un générateur de profil, que j'ai enregistré ici. C'est un programme AutoLISP écrit par L.Bouquillon le 24.03.97, adapté par Maxence Delannoy. La dernière modification le 07.08.99 et l'objet est de générer des profils. Compte tenu que ce lisp utilise beaucoup de fichiers annexes (dcl, slb, dat...), j'ai peut être oublié d'en copier un. Enfin tu me diras si ça ne marche pas. Amicalement Vincent

Bip Bip, j'ai été plus rapide... http://www.lecoyote.net/coybip/bipbip.jpg Amicalement Vincent

Bonjour, heureux que ça te serve et bienvenu parmi nous jobs. (defun c:ptatdist () (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) (setq sp (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace *acdoc*) (vla-get-ModelSpace *acdoc*) ) ) (setq ent (car (entsel))) (while (setq x (getdist "\nDistance depuis départ : ")) (setq vlaobj (vlax-ename->vla-object ent)) (vla-addPoint sp (vlax-3d-point (vlax-curve-getPointAtParam vlaobj (vlax-curve-getParamAtDist vlaobj x))) ) ) (princ) ) En espérant te relire souvent ;) Amicalement Vincent

Bonjour, Je ne me serais pas permis d'adresser cette réponse ni à Autodesk ni à toi. En fait, la réponse s'adressait à moi, puisque dans mon exemple, j'utilise vla--GetDynamicBlockProperties qui renvoie variant qu'il faut encore transformer en liste pour l'exploiter avec lisp, alors que (Gile) utilise (vlax-invoke source 'GetDynamicBlockProperties) qui renvoie directement une liste. Désolé pour le malentendu Amicalement Vincent

ReRe, http://web.univ-pau.fr/~puiseux/enseignement/Recreation/img014.jpeg Amicalement Le Shadock

Bonjour, Pour moi, le plus difficile avec les blocs dynamiques était de trouver la commande (vla-getdynamicblockproperties source) ou (vlax-invoke source 'GetDynamicBlockProperties) qui nous ouvrent la porte sur les données qui correspondent aux paramètres dynamiques d'un bloc. C'est vrai que ce n'est pas beaucoup expliqué dans l'aide et il m'a fallu un peu de temps pour trouver. Pour mémoire, voilà ce qu'on trouve dans l'aide On en avait parlé ici Amicalement Vincent

Bonjour, Même remarque que (gile) au sujet de la différence entre un jeu de sélection et une liste. Mais il s'agit sans doute d'un abus de langage, puisque Tiboulen a appelé ses variables jsbn (js pour jeu de sélection je suppose). De mon côté j'ai fait ceci (defun ssaddjs (JSADD JS / I) (setq I 0) (repeat (sslength JSADD) (setq JS (ssadd (ssname JSADD I) JS)) (setq I (+ I 1)) ) JS ) (defun c:test () ;; ... ;; ...... ;;(setq jsb1 (ssget "X" (list (cons 0 "INSERT") (cons 2 sb1)))) ;;(setq jsb2 (ssget "X" (list (cons 0 "INSERT") (cons 2 sb2)))) ;;(setq jsb3 (ssget "X" (list (cons 0 "INSERT") (cons 2 sb3)))) (setq JSTOT (ssaddjs jsb1 (ssaddjs jsb2 (ssaddjs jsb3 (ssadd))))) ) Amicalement Vincent

je regarde et les bras m'en tombent... apply, mapcar et la fonction lambda sont des choses que je n'utilise pas assez. Et c'est une faute quand on voit ce qu'il est possible de faire avec. Amicalement Vincent

Bonjour, Une fois qu'on a compris comment ça marche, on trouve cela forcément élégant. De plus, dans le cas qui nous intéresse, je vois mal comment on pourrait répondre à la question simplement sans utiliser la récursivité ? Je reprends à mon compte les mots des Patrick_35, au sujet du challenge 24 Amicalement Vincent

Bonjour, (defun arbo (REPERT / LISTREP REP) ;; utilisation ;; (arbo "c:") ;; (arbo "c:\\rep1") ;; (arbo "c:\\rep1\\rep2") ;; etc ... (setq LISTREP (vl-directory-files REPERT nil -1)) (if (= (car LISTREP) ".") (setq LISTREP (cddr LISTREP)) ) (while LISTREP (setq REP (car LISTREP) LISTREP (cdr LISTREP) ) (print (strcat REPERT "\\" REP)) (arbo (strcat REPERT "\\" REP)) ) (princ) ) Amicalement Vincent

Vous êtes trop forts... (defun min-list (ll) (if (atom ll) ll (if (null (cdr ll)) (min-list (car ll)) (min (min-list (car LL)) (min-list (cdr LL))) ) ) ) Voilà ce que j'avais en magasin. C'est moins bien qu'avec le mapcar, il suffit de faire un trace de la fonction pour s'en apercevoir. Sinon, en m'inspirant (très fortement) de ce que vous avez faits, on pourrait aussi écrire (defun min-listv (lst) (car (vl-sort (mapcar (function (lambda (x) (if (listp x) (min-listv x) x ) ) ) lst ) '<) ) ) histoire que ça marche pour tout type de liste. Amicalement Vincent [Edité le 28/8/2008 par zebulon_]

Bonjour, chaque nombre peut être un réel ou un entier. La fonction min renvoie un réel si un des arguments est un réel, sinon elle renvoie un entier. Associé à apply, min donne quelque chose de pas mal (apply 'min '(5 3 2 0 -1.5)) -1.5 On pourrait aussi utiliser la fonction de tri vl-sort (car (vl-sort '(5 3 2 0 -1.5) '<)) -1.5 l'avantage c'est que la liste pourrait être alphanumérique (ce qu'on sait gérer avec vl-sort mais pas avec min) (car (vl-sort '("c" "d" "a") '<)) "a" Maintenant, il ne reste "que" la récursivité Amicalement Vincent

Bonjour, un petit indice : c'est un challenge où on peut (où on doit...) s'intéresser à la récursivité. Autre indice : dans la condition d'arrêt j'ai utilisé la fonction (atom article). Mais on peut aussi avoir une préférence pour (listp article). J'avais omis de préciser qu'il s'agissait d'une liste de nombres, ce qui permet l'utilisation de la fonction (min nombre nombre ...) Amicalement Vincent

Bonjour, on s'est déjà pris la tête avec des tris sur des listes. C'est un sujet similaire, car je souhaite obtenir le minimum d'une liste avec une fonction qu'on va appeler min-list. Quand on a : (setq L '(5 3 2 8 10 5 0 -3 8 -3)) on obtient : (min-list L) -3 Là, c'est facile, puisqu'il suffit de faire un tri et de prendre le premier de la liste. Là ou je voudrais corser la chose c'est en demandant la même chose sur une liste de listes, comme sur cet exemple : (setq L '(1 (2 4 6 0) (3 -1 (2 -5)) 4 5 6)) où (min-list L) doit donner -5 Amicalement Vincent [Edité le 27/8/2008 par zebulon_]

Bonjour, Grammaticalement, maitre Capello me dit que c'est l'amie qui s'excite, puisque le pronom "elle" remplace le nom "amie" de même genre et de même nombre qui le précède. Mais pourquoi s'excite-t-elle, là est la question ? Amicalement Vincent

Bonjour, j'ai déjà eu de (rares) soucis avec sssetfirst sur certains fichiers où l'on ne voyait pas apparaitre les poignées. Et je ne suis pas le seul dans ce cas. Il se trouve que, quelques fois, les poignées ne sont pas visibles (même avec PICKFIRST et GRIPS à 1) mais les objets sont quand même sélectionnés. Et si on fait un REGEN, les poignées apparaissent comme par magie. Je n'utilise encore que la version 2007 sur Windows XP et je ne sais pas comment ça peut réagir sur des versions plus récentes. Amicalement Vincent

Bonjour, Je viens un peu tard, désolé. Mais comme le sujet est intéressant, je me permet de rajouter une couche. Pour ma part, je me suis fait il y a quelques temps une fonction qui demande de saisir une ou des entités et qui "grippe" le ou les calques (avec sssetfirst) qui correspondent. Après, je lance manuellement la commande autocad que je veux, que ce soit Effacer, Copier, Deplacer, Ordretrace, copier/coller etc.. qui s'applique sur les entités grippées. (defun c:laysel (/ SS FILTRE I E LAY) (setq SS (ssget)) (if SS (progn (setq FILTRE '((-4 . "OR>")) ) (setq I 0) (while (< I (sslength SS)) (setq E (entget (ssname SS I))) (setq LAY (assoc 8 E)) (setq FILTRE (cons LAY FILTRE)) (setq I (+ I 1)) ) (setq FILTRE (cons '(-4 . " (setq SS (ssget "_X" FILTRE)) (sssetfirst SS SS) ) ) (princ) ) J'aime le côté polyvalent de la chose... Amicalement Vincent

Salut, On ne peut rien te cacher. D'ailleurs, le angle_3pts vient de la même fontaine. Par contre, getPolySegs et getArcInfo viennent d'Afralisp. Comme quoi, il ne faut pas que savoir manger à tous les râteliers, il faut aussi savoir boire à toutes les sources. Pour le reste, c'est du bricolage maison. Quand même... ;) Amicalement Vincent [Edité le 12/8/2008 par zebulon_]

oops, il manquait un bout... ;; ASIN et ACOS Retournent l'arc sinus ou l'arc cosinus du nombre, en radians (defun ASIN (num) (if (<= -1 num 1) (atan num (sqrt (- 1 (expt num 2)))) (princ "\nErreur: L'argument pour ASIN doit être compris entre -1 et 1" ) ) ) (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" ) ) ) C'est vrai que, curieusement, Lisp ne connait pas Asin et Acos. Le Asin ne sert pas dans ce lisp, mais ça vous permet de vous le mettre de côté, si besoin. Je vois que j'ai les mêmes sources que Patrick_35 ;) Amicalement Vincent

"-fhach" c'est la commande de hachure "_p" c'est pour avoir accès au propriétés de cette commande "_u" c'est pour faire une hachure de type "Utilisateur" "45" c'est l'angle des traits de hachure D la distance entre deux traits de hachure. D est une variable, dans laquelle on stocke la largeur du chemin. Donc plus D est grand, moins la hachure sera dense (et inversement, bien sûr) "_n" pour dire qu'on ne veut pas de hachures doubles "_s" pour sélectionner des contours à hachurer (entlast) c'est la dernière entité, fabriquée par _pedit, et qui sert de contour "" pour terminer le "choix de objets" formant les contours "" pour sortir de la commande. Si tu veux de l'ANSI, il faut modifier cette ligne. Le mieux, c'est de le faire "à la main" dans Autocad et noter tout ce qu'on tape et le reproduire dans le lisp. Personnellement, j'utilise autant que possible les hachures "utilisateur" : elles sont simples (angle + distance) et, en plus, la distance demandée est en unités de dessin. Il n'y a pas de notion d'échelle (où on n'a jamais ce qu'on veut du premier coup !) comme pour les autres types de hachures. Pour Stéphane, la duplication est à proscrire, surtout en programmation. Dupliquer tout un lisp parce qu'il y a une ligne qui change, c'est un peu violent. Amicalement Vincent Et arrêtez de m'appeler Monsieur. On n'est pas à l'école. [Edité le 7/8/2008 par zebulon_]

Bonjour, j'ai modifié le lisp ci-dessus et j'ai rajouté un getreal (on peut faire mieux, mais c'est plus cher) pour que le lisp vous demande à chaque fois la largeur voulue. Au départ, le lisp demande à l'utilisateur de tracer une polyligne dont il fait 2 "décaler", un à droite et un à gauche. Le lisp utilise la commande Autocad _PLINE et, de ce fait (et sans trop se fatiguer à programmer) il y a possibilité d'entrer un ou plusieurs segments courbes. Donc, il suffit de dessiner intelligemment la polyligne de construction avec les rayons qui vont bien. Tu pourrais partager ta personnalisation. Cela pourrait peut être en intéresser l'un ou l'autre. Amicalement Vincent

Bonjour, quelque chose qui transforme des nuages en polyligne formée uniquement de segments droits. (defun getPolySegs (ent / entl p1 pt bulge seg ptlst) (cond (ent (setq entl (entget ent)) ;; save start point if polyline is closed (if (= (logand (cdr (assoc 70 entl)) 1) 1) (setq p1 (cdr (assoc 10 entl))) ) ;; run thru entity list to collect list of segments (while (setq entl (member (assoc 10 entl) entl)) ;; if segment then add to list (if (and pt bulge) (setq seg (list pt bulge)) ) ;; save next point and bulge (setq pt (cdr (assoc 10 entl)) bulge (cdr (assoc 42 entl)) ) ;; if segment is build then add last point to segment ;; and add segment to list (if seg (setq seg (append seg (list pt)) ptlst (cons seg ptlst)) ) ;; reduce list and clear temporary segment (setq entl (cdr entl) seg nil ) ) ) ) ;; if polyline is closed then add closing segment to list (if p1 (setq ptlst (cons (list pt bulge p1) ptlst))) ;; reverse and return list of segments (reverse ptlst) ) (defun getArcInfo (segment / a p1 bulge p2 c p3 p4 p r s result) ;; assigner variables avec les valeurs de l'argument (mapcar 'set '(p1 bulge p2) segment) (if (not (zerop bulge)) (progn ;; trouver la corde (setq c (distance p1 p2)) ;; trouver la flèche (setq s (* (/ c 2.0) (abs bulge))) ;; trouver le rayon par Pythagore (setq r (/ (+ (expt s 2.0) (expt (/ c 2.0) 2.0)) (* 2.0 s))) ;; distance au centre (setq a (- r s)) ;; coordonnées du milieu de p1 et P2 (setq P4 (polar P1 (angle P1 P2) (/ c 2.0))) ;; coordonnées du centre (setq p (if (>= bulge 0) (polar p4 (+ (angle p1 p2) (/ pi 2.0)) a) (polar p4 (- (angle p1 p2) (/ pi 2.0)) a) ) ) ;; coordonnées de P3 (setq p3 (if (>= bulge 0) (polar p4 (- (angle p1 p2) (/ pi 2.0)) s) (polar p4 (+ (angle p1 p2) (/ pi 2.0)) s) ) ) (setq result (list p r)) ) (setq result nil) ) result ) ;;; angle par trois points par le "théorème de Carnot" (defun angle_3pts (som p1 p2 / d1 d2 d3) (setq d1 (distance som p1) d2 (distance som p2) d3 (distance p1 p2) ) (if (and (< 0 d1) (< 0 d2)) (acos (/ (+ (* d1 d1) (* d2 d2) (- (* d3 d3)) ) (* 2 d1 d2) ) ) ) ) (defun list->variantArray (ptsList / arraySpace sArray) ; allocate space for an array of 2d points stored as doubles (setq arraySpace (vlax-make-safearray vlax-vbdouble ; element type (cons 0 (- (length ptsList) 1) ) ; array dimension ) ) (setq sArray (vlax-safearray-fill arraySpace ptsList)) ; return array variant (vlax-make-variant sArray) ) (defun c:cloud2ang (/ AcDoc Space e eobj segs LSOM DISTonPLINE P1 bulge P2 ANG3P LARC P3 LSOM NewPLINE LAYER CWIDTH) (vl-load-com) (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (setq e (car (entsel))) (setq eobj (vlax-ename->vla-object e)) (setq segs (getpolysegs e)) (setq LSOM nil) (setq DISTonPLINE 0) (while segs (setq seg (car segs)) (setq segs (cdr segs)) (mapcar 'set '(P1 bulge P2) seg) (mapcar 'set '(C R) (getarcinfo seg)) (setq ANG3P (angle_3pts C P1 P2)) (setq LARC (* ANG3P R)) (setq P3 (vlax-curve-getpointatdist (vlax-ename->vla-object e) (+ DISTonPLINE (* LARC 0.5)))) (setq p3 (list (car p3) (cadr p3))) (setq DISTonPLINE (+ DISTONPLINE LARC)) (setq LSOM (append LSOM P1 P3 P2)) ) (setq LSOM (List->VariantArray LSOM)) (setq NewPLINE (vla-addLightweightPolyline space LSOM)) (setq LAYER (vla-get-layer eobj)) (setq CWIDTH (vla-get-ConstantWidth eobj)) (vla-put-layer NewPLINE LAYER) (vla-put-ConstantWidth NewPLINE CWIDTH) (vla-delete eobj) (princ) ) Amicalement Vincent

Faut croire que zizou_elec est parti en vacances ;)

ouais, moi j'ai des statistiques minables ;) inscrit le 5/2/03 (0.36 messages par jour) pour 684 messages (0.66% de tous les messages.) Autant dire que j'ai encore du grain à moudre pour rattraper Tramber (ou d'autres), mais je m'applique... (et hop (+1) aussi) Amicalement Vincent

Bonjour, J'ai la même interrogation que (gile) : pourquoi vouloir absolument utiliser un lisp ? Si c'est juste pour que dcc lance la commande "_explode", je me dis qu'un alias défini dans "acad.pgp" ferait très bien l'affaire ? Là j'ai l'impression qu'on écrase une mouche avec un char d'assaut. ;) A moins qu'il y ait une raison qui m'échappe et qui t'oblige, yusukens82, à devoir absolument utiliser un lisp ? Dans ce cas je te remercie d'éclairer ma lanterne. Amicalement Vincent