Didier-AD

on est demain soir... (defun test5a10 (l) (apply 'and (mapcar '(lambda (nb) (and (> nb 5) (< nb 10))) l)) ) plus général car il ne faut éviter de coder avec des valeurs "en dur" (defun testlimites (l inf sup) (apply 'and (mapcar '(lambda (nb) (and (> nb inf) (< nb sup))) l)) ) (testlimites '(6 6.5 7 8 8.5 9) 5 10) retourne T [Edité le 25/5/2007 par Didier-AD]

Bravo Patrick, Sans inversion des doublets, je crois qu'on ne peut pas faire plus concis. mais çà ne marche pas avec des doublets qui forment un contour fermé essaie avec la liste suivante, tu verras. (setq lz '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0)) ((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0)) ((12.0 3.0 0.0) (1.0 2.0 0.0)) ;;;segment ajouté pour fermer le contour ((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0)) ((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0)) ((10.0 5.0 0.0) (12.0 5.0 0.0)) )) [Edité le 25/5/2007 par Didier-AD]

une idée de challenge un peu plus qu'intermédiaire pour les fanas des gestions de listes Elle me vient du problème posé par BonusCAD concernant la projection d'une polyligne 2D sur un modèle de terrain à facettes Soit une série de doublets de points correpondant à des segments de polyligne 3D à construire ((P1 P2) (P5 P6) (P9 P10) (P2 P3) (P7 P8) (P4 P5) (P6 P7).(P3 P4)......) il s'agit de les remettre dans l'ordre en faisant correspondre les débuts de doublet et les extrèmités (P1 P2) (P2 P3) (P3 P4) (P4 P5) (P6 P7) (P7 P8) (P8 P9) (P9 P10)...... dans un premier temps on pourra considérer que les doublets ne sont pas à inverser; dans un second temps on pourra imaginer avoir récupéré aussi bien (P5 P6) que (P6 P5) exemple (Sortlist '(((3.0 4.0 0.0) (3.0 6.0 0.0)) ((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0)) ((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0)) ((4.0 7.0 0.0) (6.0 7.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0)) ((9.0 3.0 0.0) (10.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0)) ((10.0 5.0 0.0) (12.0 5.0 0.0)) )) donne (((1.0 2.0 0.0) (1.0 4.0 0.0)) ((1.0 4.0 0.0) (3.0 4.0 0.0)) ((3.0 4.0 0.0) (3.0 6.0 0.0)) ((3.0 6.0 0.0) (4.0 7.0 0.0)) ((4.0 7.0 0.0) (6.0 7.0 0.0)) ((6.0 7.0 0.0) (6.0 4.0 0.0)) ((6.0 4.0 0.0) (7.0 3.0 0.0)) ((7.0 3.0 0.0) (9.0 3.0 0.0)) ((9.0 3.0 0.0) (10.0 5.0 0.0)) ((10.0 5.0 0.0) (12.0 5.0 0.0)) ((12.0 5.0 0.0) (12.0 3.0 0.0))) ce sont des points 2D mais çà doit marcher aussi avec les points 3D PS, je n'ai pas encore cherché donc je n'ai pas encore de solution Ps2 : Après réflexion, En fait, c'est assez simple... [Edité le 24/5/2007 par Didier-AD]

j'ai réussi à charger ton dessin et ton application ; j'ai essayé, j'ai regardé ton lisp et je crois que j'ai compris pour chaque point de tes polylignes décalées, tu effectus une sélection par capture autour du point ensuite pour chaque 3DFace trouvée, tu effectue un calcul de point (ligne 95) seulement si le point de ta polyligne est inclu dans ta facette (ligne 86) sur l'image ci dessous, on voit bien que les facettes 1, 2 et 3 ne contiennent pas de point de tes polylignes décalées ; elles ne sont donc pas prises en compte http://xs215.xs.to/xs215/07215/Image2.jpg sur un segment droit de ta dalle, tu pourrais même louper des facettes et avoir une polyligne 3D qui oublie des trous et des bosses de ton MNT(tu vois j'apprends vite) la routine que je t'ai fournie dans le message précédent raisonne sur un segment et non pas autour d'un point, elle prendra donc en compte les extrémités mais il faudra que tu gères les points en double. en cas de pb n'hésites pas à appeler à l'aide, j'ai peut-être une autre idée d'algorythme.

ce qui suit devrait pouvoir t'aider c'est une fonction qui recherche les points d'intersection entre un segment (à priori 2D) et une facette définie par 3 points ; elle retourne soit nil soit une liste de deux points 3D je te propose d'abord de l'essayer avec la commande TEST jointe (qui suppose que la face 3D n'a que 3 points) ; s'il y a une projection possible, la commande test dessine une ligne rouge j'ai essayé,çà fonctionne avec - un segment qui traverse complètement la 3Dface - un segment completement contenu dans la 3DFace - un segement qui coupe un seul coté de la 3DFace je te propose d'utiliser la fonction comme çà: repérer toutes tes 3dfaces par un ssget "capture polygone" avec les points de ta polyligne ensuite, pour chaque face3D, tu utilises la fonction avec chaque segment de ta polyligne çà devrait te donner une liste de points avec laquelle tu peux générer(après nettoyage) ta polyligne 3D si tes 3Dfaces ont 4 cotés tu peux les diviser en 2 triangles ou bien tu peux l'intéger dans ton algorythme qui a l'air déjà avancé, bon courage ;;---Début---------------------------------------------------int-pvectoriel------ ;; << calcule le produit vectoriel de deux vecteurs >> ;; << >> ;; ;; créée le : jeudi 24 mai 2007 à 20:54 ;; ;; Admet : ;; ======= ;; V1 : Liste = coordonnées ;; V2 : Liste = coordonnées ;; ;; Retourne : Liste = vecteur produt scalaire ;; ========== ;------------------------------------------------------------------------------- (Defun int-pvectoriel ( V1 V2 / ) ; ajouter si nécessaire la coordonnée Z à V1 (if (not (caddr V1)) (setq V1 (append V1 (list 0))) ) ; ajouter si nécessaire la coordonnée Z à V2 (if (not (caddr V2)) (setq V2 (append V2 (list 0))) ) (list (- (* (cadr V1) (caddr V2)) (* (caddr V1) (cadr V2))) (- (* (caddr V1) (car V2)) (* (car V1) (caddr V2))) (- (* (car V1) (cadr V2)) (* (cadr V1) (car V2))) ) ) ;;---fin-----------------------------------------------------int-pvectoriel------ ;;---Début---------------------------------------------------int-adroite--------- ;; << vérifie qu'un point est à droite d'un segment >> ;; << >> ;; ;; créée le : jeudi 24 mai 2007 à 21:03 ;; ;; Admet : ;; ======= ;; A : Point = premier point du segment ;; B : Point = second point du segment ;; P : Point = à tester ;; ;; Retourne : Entier = -1 si à gauche 0 dessus 1 si à droite ;; ========== ;------------------------------------------------------------------------------- (Defun int-adroite ( A B P / v) (setq v (int-pvectoriel (mapcar '- B A) (mapcar '- P A))) (cond ((minusp (caddr v)) -1) ((equal (caddr v) 0.0 1e-9) 0) (t 1) ) ) ;;---fin-----------------------------------------------------int-adroite--------- ;;---Début---------------------------------------------------int_danstriangle---- ;; << vérifie qu'un point est à l'intérieur d'un triangle >> ;; << (soit toujours à droite soit toujours à gauche des cotés) >> ;; ;; créée le : jeudi 24 mai 2007 à 21:06 ;; ;; Admet : ;; ======= ;; pt : Point = à tester ;; triangle : Liste = de points ;; ;; Retourne : Booléen = T si à l'intérieur Nil si à l'extérieur ;; ========== ;------------------------------------------------------------------------------- (defun int-danstriangle (pt triangle / lad) (setq lad (mapcar '(lambda (A B) (int-adroite A B pt) ) (mapcar 'int-xy triangle) (mapcar 'int-xy (cons (last triangle) (int-xy triangle))) ) lad (vl-remove-if 'zerop lad) ) (apply 'and (mapcar '(lambda (v) (= v (car lad))) lad)) ) ;;---fin-----------------------------------------------------int_danstriangle---- ;;---Début---------------------------------------------------int-xy-------------- ;; << retourne les deux premier termes d'une liste >> ;; << >> ;; ;; créée le : jeudi 24 mai 2007 à 21:09 ;; ;; Admet : ;; ======= ;; pt : Liste = ;; ;; Retourne : Liste = '((car pt) (cadr pt)) ;; ========== ;------------------------------------------------------------------------------- (Defun int-xy ( pt / ) (list (car pt) (cadr pt)) ) ;;---fin-----------------------------------------------------int-xy-------------- ;;---Début---------------------------------------------------int-proj------------ ;; << donne la projection selon Z d'un point sur un plan >> ;; << >> ;; ;; créée le : jeudi 24 mai 2007 à 21:10 ;; ;; Admet : ;; ======= ;; pt : Point = point à projeter verticalement sur le plan ;; triangle : Liste = de 3 points définissant le plan ;; ;; Retourne : Point = 3D ;; ========== ;------------------------------------------------------------------------------- (defun int-proj (pt triangle / Nx Ny Nz C) ; l'équation du plan vérifie Nx*X + Ny*Y + Nz*z + C =0 ; avec Nx,Ny,Nz les coordonnées du vecteur normal au plan qu'on obtient par le produit vectoriel de deux cotés du triangle (mapcar 'set (list 'Nx 'Ny 'Nz) (int-pvectoriel (mapcar '- (cadr triangle) (car triangle)) (mapcar '- (last triangle) (car triangle)))) (setq C (- 0 (* Nx (caar triangle)) (* Ny (cadar triangle)) (* Nz (caddar triangle)))) (list (car pt) (cadr pt) (/ (+ C (* Nx (car pt)) (* Ny (cadr pt))) Nz -1.0) ) ) ;;---fin-----------------------------------------------------int-proj------------ ;;---Début---------------------------------------------------int-seg-triangle---- ;; << recherche la projection d'un segment 2D verticalement sur une facette >> ;; << définie par 3 points >> ;; ;; créée le : jeudi 24 mai 2007 à 21:14 ;; ;; Admet : ;; ======= ;; seg : Liste = de deux points (à priori 2D) ;; triangle : Liste = de 3 points définissant la facette 3D ;; ;; Retourne : Liste = de deux points ou nil si pas de projecion ;; ========== ;------------------------------------------------------------------------------- (defun int-seg-triangle (seg triangle / lint) ; recherche des intersections (2D) entre le segment et le triangle (setq lint (mapcar '(lambda (p1 p2) (inters (int-xy p1) (int-xy p2) (int-xy (car seg)) (int-xy (cadr seg)) T) ) triangle (cons (last triangle) (int-xy triangle)) ) lint (vl-remove-if 'null lint) ) (cond ((zerop (length lint)) ; pas d'intersection trouvées (if (int-danstriangle (car seg) triangle) ; un point est dans le triangle donc les 2 y sont (list (int-proj (car seg) triangle) (int-proj (cadr seg) triangle)) ) ) ((= 1 (length lint)) ; une intersection trouvée (if (int-danstriangle (car seg) triangle) ; premier point dans le triangle ? (list (int-proj (car seg) triangle) (int-proj (car lint) triangle)) (list (int-proj (car lint) triangle) (int-proj (cadr seg) triangle)) ) ) (t ; 2 intersections trouvées ; les mettre dans le bon ordre (if (< (distance (car lint) (int-xy (car seg))) (distance (cadr lint) (int-xy (car seg)))) (list (int-proj (car lint) triangle) (int-proj (cadr lint) triangle)) (list (int-proj (cadr lint) triangle) (int-proj (car lint) triangle)) ) ) ) ) ;;---fin-----------------------------------------------------int-seg-triangle---- (defun c:test (/ face ent seg trian ptmp) (setq face (car (entsel "\n pointez une face 3d"))) (setq ent (entget face)) (if (= "3DFACE" (cdr (assoc 0 ent))) (setq seg (list (setq ptmp(getpoint "\npremier point du segment")) (getpoint ptmp "\n second point du segment") ) trian (list (cdr (assoc 10 ent)) (cdr (assoc 11 ent)) (cdr (assoc 12 ent))) ) ) (if seg (if (setq seg1 (int-seg-triangle seg trian)) (entmake (list (cons 0 "LINE") (cons 10 (car seg1)) (cons 11 (cadr seg1)) (cons 62 1) ) ) (alert "pas de projection possible") ) (alert "Tant pis") ) )

Ta demande est assez difficile à cerner car tu parles à la fois d'entités autoCAD et d'objets "métier" c'est quoi un MNT ? essaie de parler uniquement métier ou uniquement AutoCAD j'ai travaillé un peu en topo3D et je dois avoir encore des outils pour t'aider en plus, le lien que tu proposes ne fonctionne pas

Ce qui est super c'est de se souvenir de la démonstration ; bravo

ben voilà, maintenant il y a l'image ,merci du tuyau

Pour ceux qui auraient besoin de calculer la surface d'une zone délimitée par une liste de points sans être obligé de dessiner une polyligne et calculer son aire, voici une fonction qui le fait très bien ; elle est issue d'une formule basée sur le calcul vectoriel http://xs215.xs.to/xs215/07214/calcsurf.jpg (defun SurfaceContour (lp / lx ly Total n soustotal) (defun soustotal (X Ya Yb) (* X (- Ya Yb))) (setq lx (mapcar 'car lp) ly (mapcar 'cadr lp) Total (soustotal (car lx) (cadr ly) (last ly)) n 1 ) (repeat (- (length lp) 2) (setq total (+ total (soustotal (nth n lx) (nth (1+ n) ly) (nth (1- n) ly))) n (1+ n) ) ) (setq total (+ total (soustotal (last lx) (car ly) (cadr (reverse ly))))) (abs (/ total 2.0)) ) (defun c:test (/ pt lp) (setq pt (getpoint "\npremier point") lp (list pt) ) (while (setq pt (getpoint "\n point suivant")) (setq lp (cons pt lp)) ) (alert (strcat "Surface du contour = " (rtos (SurfaceContour lp) 2 3) " Unité²")) ) [Edité le 23/5/2007 par Didier-AD]

En fonction d'un besoin concernant les présentations as tu un besoin particulier concernant les présentations afin que je puiss te donner un exemple d'utilisation ?

Didier si tu continues à dire des trucs sans faire la moindre vérif, tu vas finir par passer pour un rigolo ! Pour revenir à ces trucs de géométrie vectorielle, je trouvais çà "ennuyeux" (pour être poli) quand j'étais au lycée et puis un jour j'ai demandé une idée pour un algorythme à un prof de math et je me suis trouvé tout penaud On devrait toujours croire, quand on est à l'école qu'un jour çà pourait servir....

Je viens de mettre ma bibliothèque de gestion des présentations dans la rubrique Routines LISP tu devrais trouver ton bonheur.

Il y en a à moi, d'autres que j'ai glanées ici et là, en particulier dans ce forum voici donc ma bibliothèque de gestion des présentations ; (vl-load-com) ;;---Début---------------------------------------------------Pres_FindLayouts- ;; << recherche le VLA-OBJECT correspondant à la collection de layouts >> ;; << >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:39 ;; ;; Admet : ;; ======= ;; ;; Retourne : VLA-OBJECT = collection des layout ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_FindLayouts ( / acadobj acaddoc ) (setq acadobj (vlax-get-acad-object) acaddoc (vlax-get-property acadobj 'ActiveDocument) ) (vlax-get-property acaddoc 'Layouts) );........... ;;---fin-----------------------------------------------------Pres_FindLayouts- ;;---Début---------------------------------------------------Pres_Find_a_Layout ;; << trouve le VLA-OBJECT correspondant à une présentation >> ;; << >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:45 ;; ;; Admet : ;; ======= ;; lenom : Chaine = nom du Layout ;; ;; Retourne : VLA-OBJECT = trouvé ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_Find_a_Layout ( lenom / Layo count n nom ly found) (setq layo (Pres_FindLayouts) count (vlax-get-property layo 'Count) n 0 ) (repeat count (setq nom (vlax-get-property (setq ly (vlax-invoke-method layo 'item n)) 'Name)) (if (= lenom nom) (setq found ly)) (setq n (1+ n)) ) found );........... ;;---fin-----------------------------------------------------Pres_Find_a_Layout ;;---Début---------------------------------------------------Pres_Ajoutepres-- ;; << ajoute une présentation mais verifie si une présenation porte ce nom >> ;; << si oui retourne le vla-object de cette présentation, >> ;; << si non crée une nouvelle présentation >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:23 ;; ;; Admet : ;; ======= ;; lenom : Chaine = nom de la présentation ;; ;; Retourne : vla-object = nom activeX de la présentation ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_Ajoutepres ( lenom / layo existe) ;;; MOD1 (if (setq existe (Pres_Find_a_Layout (strcase lenom))) existe (vlax-invoke-method (Pres_FindLayouts) 'Add lenom) ) );........... ;;---fin-----------------------------------------------------Pres_Ajoutepres-- ;;---Début---------------------------------------------------Pres_RenamePres-- ;; << renomme une présentation >> ;; << >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:27 ;; ;; Admet : ;; ======= ;; oldname : Chaine = ancien nom ;; Newname : Chaine = nouveau nom ;; ;; Retourne : ObjectName de la présentation ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_RenamePres ( OldName NewName / ly) (setq ly (Pres_Find_a_layout oldName)) (if ly (vlax-put-property ly 'Name NewName)) ly ;;; MOdification Alain );........... ;;---fin-----------------------------------------------------Pres_RenamePres-- ;;---Début---------------------------------------------------Pres_DeletePres-- ;; << efface une présentation >> ;; << >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:34 ;; ;; Admet : ;; ======= ;; lenom : Chaine ou VLA-OBJECT = nom de la présentation ou son VLA-OBJECT ;; ;; Retourne : Sans intérêt = ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_DeletePres ( lenom / ly) (if (= (type lenom) 'VLA-OBJECT) (setq Ly lenom) (setq ly (Pres_Find_a_Layout lenom)) ) (if ly (vlax-invoke-method ly 'delete)) );........... ;;---fin-----------------------------------------------------Pres_DeletePres-- ;;---Début---------------------------------------------------Pres_Listepres--- ;; << liste tous les Layouts d'un dessin >> ;; << Y compris "model" >> ;; ;; créée le : vendredi 17 novembre 2000 à 00:53 ;; modifié par Alain ;; Admet : ;; ======= ;; ;; Retourne : Liste = des noms de layouts dans l'ordre d'affichage des onglets ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_Listepres ( / layo count n nom lnom lay) (setq layo (Pres_FindLayouts) count (vlax-get-property layo 'Count) n 0 ) (repeat count (setq nom (vlax-invoke-method layo 'item n) ;; récupère l'ObjectName lnom (cons (cons (itoa (vla-get-TabOrder nom)) ;; récupère l'ordre d'affichage transformé en STRING pour faciliter le trie (vla-get-Name nom) ;; récupère le nom d'affichage ) lnom ) n (1+ n) ) ) ;;; je pense que tu avoir des routines de trie mais je propose celle-ci (mapcar (function (lambda(x) (cdr (assoc x lnom)))) (acad_strlsort (mapcar 'car lnom)) ;; efectue le trie ) );........... ;;---fin-----------------------------------------------------Pres_Listepres--- ;;---Début--------------------------------------------------Pres_SetCLayouts-- ;; << fixe le layout courant >> ;; << >> ;; ;; créée le : lundi 20 novembre 2000 à 22:00 ;; ;; Admet : ;; ======= ;; name : Chaine = nom du layout si nil, espace objet ;; ;; Retourne : VLA-OBJECT = ObjectName du layout ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_SetCLayouts ( name / layout acaddoc ) (setq layout (cond ((and (= (type name) 'VLA-OBJECT) (= (vla-get-objectname name) "AcDbLayout") ) name ) ((= (type name) 'STR) (Pres_Find_a_Layout name) ) ) layout (if layout layout (Pres_Find_a_Layout "Model") ) ) (if layout (vla-put-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)) layout)) layout );........... ;;---fin----------------------------------------------------Pres_SetCLayouts-- ;;---Début-----------------------------------------------------Pres_CLayouts-- ;; << retourne le layout courant >> ;; << >> ;; ;; créée le : lundi 20 novembre 2000 à 22:00 ;; ;; Admet : ;; ======= ;; name : Chaine = nom du layout si nil, espace objet ;; ;; Retourne : VLA-OBJECT = ObjectName du layout courant ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_CLayout ( / layout acaddoc ) (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))) );........... ;;---fin----------------------------------------------------Pres_SetCLayouts-- ;;---Début---------------------------------------------------Pres_LayoutsOrder ;; << Reéfini l'ordre des onglets des layouts >> ;; << >> ;; ;; créée le : mardi 21 novembre 2000 à 21:22 ;; ;; Admet : ;; ======= ;; lislayout : Liste = liste des layouts ;; ;; Retourne : Sans intéret = ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_LayoutsOrder ( lislayout / layout ii) (setq ii 0) (mapcar (function (lambda(layout) (vla-put-Taborder layout (setq ii (1+ ii))) ) ) (mapcar (function Pres_Find_a_Layout) lislayout) ) );........... ;;---fin-----------------------------------------------------Pres_LayoutsOrder ;;---Début---------------------------------------------------Pres_SupViewCreLayouts ;; << Nom pas trés evocateur peut être mais qui signifie que l'on supprime >> ;; << la création d'une Fenêtre sur le Layout à la création >> ;; ;; créée le : samedi 25 novembre 2000 à 17:35 ;; ;; Admet : ;; ======= ;; ;; Retourne : Sans intéret = ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_SupViewCreLayouts ( / ) (vla-put-LayoutCreateViewport (vla-get-Display ;;; accés à l'ojet Display (en gros onglet affichage d'Option) (vla-get-Preferences ;;; accés à l'ojet Préférences géré par la commande Option (vlax-get-acad-object) ) ) 0 ;;; une valeur de 1 le rétabli ) );........... ;;---fin-----------------------------------------------------Pres_SupViewCreLayouts ;;---Début---------------------------------------------------PresName--------- ;; << Retourne le nom d'une présentation >> ;; << >> ;; ;; créée le : samedi 25 novembre 2000 à 18:49 ;; ;; Admet : ;; ======= ;; Ent : Maitien, Ename ou OjectName = Maintien ou Ename ou ObjectName de la présentation ;; ;; Retourne : Chaine = Nom de la présentation ;; ========== ;------------------------------------------------------------------------------- (Defun PresName(Ent / Obj) (if (setq Obj (if (= (type ent) 'VLA-OBJECT) Ent (progn (if (= (type ent) 'STR) (setq ent (handent ent))) (if (= (type ent) 'ENAME) (vlax-ename->vla-object ent) ) ) ) ) (vla-get-name Obj) ) );........... ;;---fin-----------------------------------------------------PresName--------- ;;---Début---------------------------------------------------PresObjName--------- ;; << Retourne l'ObjectName d'une présentation >> ;; << en vérifiant si l'objet est bien une présen >> ;; ;; créée le : samedi 25 novembre 2000 à 19:28 ;; ;; Admet : ;; ======= ;; Layout : Nom ,Maitien, Ename ou ObjectName = Maintien ou Ename ou ObjectName de la présentation ;; ;; Retourne : Objectname = ObjectName de la présentation ;; ========== ;------------------------------------------------------------------------------- (Defun PresObjName(layout / Obj) (setq obj (cond ((= (type Layout) 'STR) (if (setq tmp (handent Layout)) (vlax-ename->vla-object tmp) (Pres_Find_a_Layout layout) ) ) ((= (type Layout) 'ENAME) (vlax-ename->vla-object layout) ) ((= (type Layout) 'VLA-OBJECT) layout ) ) ) (if (and obj (= (vla-get-objectname obj) "AcDbLayout")) Obj) );........... ;;---fin-----------------------------------------------------PresObjName--------- ;;---Début---------------------------------------------------PresDimPaper----- ;; << retourne les dimensions du papier d'un layout >> ;; << >> ;; ;; créée le : lundi 4 décembre 2000 à 20:54 ;; ;; Admet : ;; ======= ;; Layout : Nom ou Obj ou Ename ou Hand = la présentation ;; ;; Retourne : Liste = (largeur hauteur) ;; ========== ;------------------------------------------------------------------------------- (Defun PresDimPaper ( Layout / tmp dimx dimy) (if (setq layout (PresObjName Layout)) (progn (vla-GetPaperSize Layout 'dimx 'dimy) (if (= (rem (vla-get-PlotRotation Layout) 2) 0) ; si c'est 0 ou 2 Portrait 1 ou 3 Paysage (list dimx dimy) (list dimy dimx) ) ) ) );........... ;;---fin-----------------------------------------------------PresDimPaper----- ;;---Début---------------------------------------------------Pres_IsPaper-------- ;; << Fonction qui retourne T si on est en espace papier complet >> ;; << >> ;; ;; créée le : dimanche 3 octobre 2004 à 19:22 ;; ;; Admet : ;; ======= ;; ;; Retourne : Booléen = T si en EP complet ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_IsPaper ( / ) (and (/= "Model" (PresName (Pres_CLayout))) (= 1 (getvar "CVPORT")) ) ) ;;---fin-----------------------------------------------------Pres_IsPaper-------- ;;---Début---------------------------------------------------Pres_IsObjet----- ;; << permet de savoir si on est en objet >> ;; << >> ;; ;; créée le : dimanche 3 octobre 2004 à 19:28 ;; ;; Admet : ;; ======= ;; ;; Retourne : Entier = 0 : en "Model" ; 1 en objet dans une présentation ; Nil en Papier ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_IsObjet ( / ) (cond ((= 1 (getvar "Tilemode")) 0 ) ((and (/= "Model" (PresName (Pres_CLayout))) (> (getvar "CVPORT") 1)) 1) (T Nil ) ) ) ;;---fin-----------------------------------------------------Pres_IsObjet----- ;;---Début---------------------------------------------------Pres_ListPlot---- ;; << donnela liste des traceurs valables >> ;; << >> ;; ;; créée le : vendredi 26 janvier 2007 à 00:44 ;; ;; Admet : ;; ======= ;; ;; Retourne : Liste = de nom de traceurs ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_ListPlot ( / Ltra) (setq Ltra (vlax-safearray->list (vlax-variant-value (vla-getplotdevicenames (vla-get-layout (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object) ) ) ) ) ) ) ) (if (vl-position "Aucun" Ltra) (setq Ltra (vl-remove "Aucun" Ltra)) ) Ltra ) ;;---fin-----------------------------------------------------Pres_ListPlot---- ;;---Début---------------------------------------------------Pres_PutPlotter-- ;; << impose un traceur à une présentation >> ;; << >> ;; ;; créée le : vendredi 26 janvier 2007 à 00:49 ;; ;; Admet : ;; ======= ;; Lay : Chaine = ou objet présentation ;; plotter : Chaine = nom du traceur ;; ;; Retourne : Booléen = T si çà s'est normalement bien passé ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_PutPlotter ( Lay plotter / ) (if (= 'STR (type Lay)) (setq Lay (Pres_Find_a_Layout Lay)) ) (if (member plotter (Pres_ListPlot)) (progn (vla-put-configname Lay plotter) T ) ) ) ;;---fin-----------------------------------------------------Pres_PutPlotter-- ;;---Début---------------------------------------------------Pres_GetPlotter-- ;; << retourne le traceur associé à une présentation >> ;; << >> ;; ;; créée le : vendredi 26 janvier 2007 à 00:49 ;; ;; Admet : ;; ======= ;; Lay : Chaine = ou objet présentation ; ;; Retourne : chaine : nom du plotter actuel ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_GetPlotter ( Lay ) (if (= 'STR (type Lay)) (setq Lay (Pres_Find_a_Layout Lay)) ) (vla-get-configname Lay ) ) ;;---fin-----------------------------------------------------Pres_GetPlotter-- ;;---Début---------------------------------------------------Pres_PutPaper-- ;; << impose un format du traceur à une présentation >> ;; << ATTENTION, NE FONCTIONNE QU'AVEC LES FORMATS Ai (A1, A2,A3,A4....) >> ;; ;; créée le : vendredi 26 janvier 2007 à 00:49 ;; ;; Admet : ;; ======= ;; Lay : Chaine = ou objet présentation ;; paper : Chaine = nom du format ;; Portrait : booléen = si 1 se débrouille pour placer le format en portrait ;; si 0 se débrouille pour placer le format en paysage ;; si nil laisse comme çà ;; ;; Retourne : Booléen = T si çà s'est normalement bien passé ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_PutPaper ( Lay paper portrait / dimx dimy) (if (= 'STR (type Lay)) (setq Lay (Pres_Find_a_Layout Lay)) ) (vla-put-canonicalmediaName Lay paper) (cond ((= portrait 1) (vla-put-plotrotation lay 0)) ((= portrait 0) (vla-put-plotrotation lay 1)) ) ) ;;---fin-----------------------------------------------------Pres_PutPaper-- ;;---Début---------------------------------------------------Pres_ListFormatsOfPres ;; << retourne la liste des formats disponibles pour une présentation >> ;; << sa configuration traceur actuelle et le format actuel >> ;; ;; créée le : mardi 30 janvier 2007 à 00:39 ;; ;; Admet : ;; ======= ;; Lay : Chaine = ou objet : layout ;; ;; Retourne : Liste = (traceur format-actuel (liste des formats Brut) (liste des formats francisés)) ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_ListFormatsOfPres ( Lay / paps lst) (if (= 'STR (type Lay)) (setq Lay (Pres_Find_a_Layout Lay)) ) (setq paps (vlax-invoke lay 'GetCanonicalMediaNames)) (setq lst (mapcar '(lambda (pap) (vla-GetLocaleMediaName Lay pap)) paps)) (list (Pres_GetPlotter Lay) (vla-get-CanonicalMediaName Lay) paps lst) ) ;;---fin-----------------------------------------------------Pres_ListFormatsOfPres ;;---Début---------------------------------------------------Pres_ListFormatsOfPlotter ;; << donne la liste des formats liés à un traceur >> ;; << >> ;; ;; créée le : mardi 30 janvier 2007 à 00:58 ;; ;; Admet : ;; ======= ;; Plotter : Chaine = traceur ;; ;; Retourne : Liste = ((formats bruts) (formats francisés)) ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_ListFormatsOfPlotter ( Plotter / esp lay paps lst lst2) ;;; ATTENTION, FONCTION LENTE !!!! (if (zerop (getvar "tilemode")) (setq esp (vla-get-paperspace (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq esp (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object)))) ) (setq Lay (vla-get-layout esp) def (vla-get-configname lay) ) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-configname (list Lay Plotter)))) (progn (vla-RefreshPlotDeviceInfo Lay) (setq paps (vlax-invoke lay 'GetCanonicalMediaNames)) (setq lst (mapcar '(lambda (pap) (vla-GetLocaleMediaName Lay pap)) paps)) (setq lst2 (list paps lst)) (vl-catch-all-apply 'vla-put-configname (list lay def)) ) (setq lst2 '("")) ) lst2 ) ;;---fin-----------------------------------------------------Pres_ListFormatsOfPlotter ;;---Début---------------------------------------------------Pres_Plot-------- ;; << lance l'impression d'un layout >> ;; << >> ;; ;; créée le : mardi 13 février 2007 à 00:07 ;; ;; Admet : ;; ======= ;; l_layout : Liste = chaines = nom des layouts ;; ;; Retourne : Sans intéret = ;; ========== ;------------------------------------------------------------------------------- (Defun Pres_Plot ( l_layout / lnom plot) (setq lnom (vlax-make-safearray vlax-vbString (cons 0 (- (length l_layout) 1)))) (vlax-safearray-fill lnom l_layout) (setq plot (vla-get-plot (vla-get-ActiveDocument (vlax-get-acad-object)))) (vlax-invoke-method plot 'SetLayoutsToPlot lnom) (vlax-invoke-method plot 'PlotToDevice) ) ;;---fin-----------------------------------------------------Pres_Plot-------- ;;---Début---------------------------------------------------C:ImprimeTout-------- ;; << lance l'impression de tous les layouts>> ;; << >> ;; ;; créée le : mardi 26 Juin 2007 à 00:36 ;; ;; Admet : ;; ======= ;; ;; Retourne : Sans intéret = ;; ========== ;------------------------------------------------------------------------------- (defun C:ImprimeTout () (Pres_Plot (cdr (Pres_ListePres))) ) ;;---fin----------------------------------------------------C:ImprimeTout-------- [Edité le 27/6/2007 par Didier-AD]

Là encore, le produit vectoriel vient à la rescousse en effet, le produit vectoriel de deux vecteurs coplanaires mais non parallèles donne un vecteur qui est perpendiculaire au plan de ces deux vecteurs (pvectoriel '(1 0 0) '(0 1 0)) donne le vecteur '(0 0 1) Dans le challenge, j'ai précisé que les 3 points étaient dans le plan XY donc le produit vectoriel sera un vecteur orienté selon Z et les lois du produit vectoriel sont telles que (pvectoriel '(1 0 0) '(0 1 0)) donne le vecteur '(0 0 1) mais (pvectoriel '(0 1 0) '(1 0 0)) donne le vecteur '(0 0 -1) En examinant le signe de cette coordonnée en Z, on peut donc connaitre la position relative de ces deux vecteurs (defun pvectoriel (V1 V2) ; ajouter si nécessaire la coordonnée Z à V1 (if (not (caddr V1)) (setq V1 (append V1 (list 0)))) ; ajouter si nécessaire la coordonnée Z à V2 (if (not (caddr V2)) (setq V2 (append V2 (list 0)))) (list (- (* (cadr V1)(caddr V2)) (* (caddr V1) (cadr V2))) (- (* (car V1)(caddr V2)) (* (caddr V1) (car V2))) (- (* (car V1)(cadr V2)) (* (cadr V1) (car V2))) ) ) (defun estadroite (A B P / v) (setq v (pvectoriel (mapcar '- B A) (mapcar '- P A))) (cond ((minusp (caddr v)) -1) ((equal (caddr v) 0.0 1e-9) 0) (t 1) ) ) En plus, et ce n'est pas à négliger, la valeur absolue de la coordonnée en Z donne la surface du triangle ABP

Ben voilà, quand on veut aller trop vite. Désolé ! il faut remplacer par (apply 'AND (mapcar '(lambda (c) (equal c 0.0 1e-9)) (pvectoriel (mapcar '- P2 P1) (mapcar '- P3 P4))))

on peut l'exprimer comme çà je précise qu'on travaille dans le plan XY car sinon çà n'a pas de sens je décroche pendant 2 jours, je verrai en rentrant. [Edité le 20/5/2007 par Didier-AD]

pour les parallèles on peut utiliser aussi le produit vectoriel, c'est le plus sûr si le produit vectoriel des deux vecteurs est un vecteur nul alors les vecteurs sont colinéaires donc parallèles voici (defun pvectoriel (V1 V2) ; ajouter si nécessaire la coordonnée Z à V1 (if (not (caddr V1)) (setq V1 (append V1 (list 0)))) ; ajouter si nécessaire la coordonnée Z à V2 (if (not (caddr V2)) (setq V2 (append V2 (list 0)))) (list (- (* (cadr V1)(caddr V2)) (* (caddr V1) (cadr V2))) (- (* (car V1)(caddr V2)) (* (caddr V1) (car V2))) (- (* (car V1)(cadr V2)) (* (cadr V1) (car V2))) ) ) (defun paral (p1 p2 p3 p4) (equal (apply '+ (pvectoriel (mapcar '- P2 P1) (mapcar '- P3 P4))) 0 1e-9) ) pour les perpendiculaire, c'est le produit scalaire qu'il faut utiliser il est nul si les vecteurs sont perpendiculaires (defun Pscalaire (V1 V2) (apply '+ (mapcar '* V1 V2)) ) (defun perpend (P1 P2 P3 p4 / pint) (if (equal (pscalaire (mapcar '- P2 P1) (mapcar '- P3 P4)) 0 1e-9) (if (setq pint (inters p1 p2 p3 p4 nil) pint (print "perpendiculaires mais non coplanaires") ) (print "non coplanaires") ) )

Rassurez vous, il ne s'agit pas de politique mais d'un petit challenge Il s'agit d'écrire une fonction qui permettra de savoir si un point P est à droite ou à gauche d'une direction donnée par deux points A et B (droiteougauche P A B) doit retourner 1 si P est à droite de AB, -1 si P est à gauche de AB 0 si P est aligné avec A et B

un vecteur directeur d'une droite passant par 2 points A(xa, ya,za) et B(xb,yb,zb) s'écrit tput simplement (xb-xa, yb-ya, zb-za) mais on ne peut pas comparer directement le vecteur issus de PT1 et ,PT2 et celui issu de PT et PT4 car, ils ne sont pas forcément de même longueur ; il faut les ramener à une unité Nota celà nécessite une division de nombres réels donc une imprécision qui oblige souvent à délaisser eq au profit de equal

Voilà On supposera utiliser les lettres de l'aphabet en minuscule car entre "Z" et "a", il y a quelques signes qui ne font pas partie de l'aphabet (defun incrStr (ch / lasc incsuiv) (setq lasc (reverse (vl-string->list ch)) incsuiv T ) (setq Newlasc (mapcar '(lambda (n /) (if incsuiv (if (> (1+ n) 122) (setq incsuiv T newasc 97) (setq incsuiv nil newasc (1+ n)) ) (setq newasc n) ) newasc ) lasc ) ) (if incsuiv (strcat "a" (vl-list->string (reverse newlasc))) (vl-list->string (reverse newlasc)) ) ) Et Zut, Giles est encore passé avant moi. [Edité le 19/5/2007 par Didier-AD]

petite précision ? tu dis que la suite de "azz" c'est "baa" celà veut il dire que le nombre de caractères doit rester le même ? en fait c'est comme pour les numéros des bagnoles (sauf quand on est à "zzz") en fait c'est comme pour les numéros des bagnoles

Je ne sais pas si c'est possible, les réels sont (étaient dans les version précédentes) exprimées avec 16 chiffre significatifs là, tu en as déjà 18.....

Je crois qu'il faut comparer ce qui est comparable une liste c'est une suite d'éléments ; d'un point de vue informatique c'est ce qu'on appelle une liste chainée : chaque élément pointe sur son suivant. Comment fonctionne CONS CONS crée un élément et établit la relation entre cet élément son suivant c'est à dire la liste ; c'est donc très rapide admettons que celà prend une unité de temps Comment fonctionne APPEND APPEND doit commencer par trouver le dernier élément de la liste puis expliquer à cet élément qu'il a un suivant ; il est évident que celà prend plus de temps que CONS car pour trouver le dernier élément de la liste il faut "descendre" cette liste depuis son origine en admettant que descendre d'un élément à son suivant correspond à une unité de temps la durée d'un APPEND c'est donc N+1 unité de temps (avec N la longueur de la liste d'origine) Donc pas de problème si on compare CONS et APPEND, c'est CONS qui gagne et plus la liste est longue plus c'est flagrant. mais le résultat n'est pas le même ; si on veut le même résultat il faut utiliser REVERSE deux fois Comment fonctionne REVERSE REVERSE commence d'abord par trouver la fin de la liste (N unité de temps) puis construit une liste à l'envers donc effectue N fois CONS, en quelque sorte on a donc une durée égale à 2N unité de temps (N pour descendre jusqu'au dernier et N fois CONS) ainsi donc 1-) (cons 11 '(1 2 3 4 5 6 7 8 9 10)) prend [b]1 unité [/b]de temps mais la liste est dans le désordre 2-) (append '(1 2 3 4 5 6 7 8 9 10) (list 11)) prendrait [b]11 unités [/b]de temps 3-) (reverse (cons 11 (reverse '(1 2 3 4 5 6 7 8 9 10))) prendrait 20+1+22 = [b]43 unités [/b] de temps Alors, il faut faire comment çà dépend de ce qu'on a à faire - pour ajouter un élément à une liste dont l'ordre importe peu, il est évident qu'il faut utiliser CONS - pour ajouter Un seul élément à la fin d'une liste il est préférable d'utiliser (append LaListe (list NouvelElement)) plutôt que (reverse (cons NouvelElement (reverse LaListe))) - pour constituer une liste de N éléments (à partir d'un fichier par exemple) il vaut mieux utiliser une syntaxe du type (repeat n (setq LaListe (cons ElementDependantDeN LaListe)) ) (setq LaListe (Reverse LaListe)) qui prendra 3N unités de temps plutôt que (repeat n (setq LaListe (append LaListe (list ElementDependantDeN))) ) qui prendrait (N*(N+1))/ 2 unités de temps c'est à dire 1 + 2 + 3 + 4 +.....+N Voilà, c'était ma contribution à la compréhension des listes Bon WE à tous [Edité le 18/5/2007 par Didier-AD]

Et bien tu vois, Bred, Giles est tombé dans le piège de Reverse dans sa dernière réponse Giles, ta première réponse est trés élégante puisqu'elle utilise la récursivité; c'est celle que j'utilise habituellement ; mais sur des listes très très longues tu risques d'atteindre la limite du tas (entre 500 et 2000 appels récursifs selon la taille de la fonction) ; dans ce cas, ta dernière réponse avec Reverse ou celle de Bred avec append conviennent mieux.

bonsoir, Vue l'heure un pas trop difficile soit une liste très longue ayant cette structure (x1 y1 z1 x2 y2 z2 x3 y3 z3........xn yn zn) comment en faire (élégamment et sans utiliser Reverse) une liste de 3 listes ((x1 x2 x3 x4......xn) (y1 y2 y3 ....yn) (z1 z2 z3 ....zn)) A demain