Rechercher dans la communauté
Affichage des résultats pour « challenge » dans sujets.
-
Re, zut, pas vu.... et maintenant que Patrick_35 et (gile) ont répondu, la difficulté du challenge augmente encore plus car maintenant il faut trouver encore plus "simple et concis"..... pffffffffffff..... encore bien joué en tout cas !
-
Salut, Super, un challenge :D Un premier jet : Edit (2) : petite amélioration (éviter quelques répétitions de l'expression (substr str 1 1) et n'utilser que deux fonctions récursives au lieu de trois) (defun challenge10gile1 (str / str-sub num-sub char) (defun str-sub (elt str / char) (if (/= "" str) (if (and (/= "." (setq char (substr str 1 1))) (or (= "" str) (numberp (read char)) ) ) (cons elt (num-sub char (substr str 2))) (str-sub (strcat elt char) (substr str 2)) ) (list elt) ) ) (defun num-sub (elt str / char) (if (/= "" str) (if (or (and (= "." (setq char (substr str 1 1))) (/= "" (substr str 2 1)) (numberp (read (strcat elt (substr str 1 2)))) ) (and (/= "." char) (numberp (read char)) ) ) (num-sub (strcat elt char) (substr str 2)) (cons (read elt) (str-sub char (substr str 2))) ) (list (read elt)) ) ) (if (and (/= "." (setq char (substr str 1 1))) (numberp (read char)) ) (num-sub char (substr str 2)) (str-sub char (substr str 2)) ) ) EDIT : corrigé un problème avec les points : (challenge10 ".mes.long: 12.52cm.") -> (".mes.long: " 12.52 "cm.") [Edité le 1/10/2007 par (gile)][Edité le 1/10/2007 par (gile)] [Edité le 4/10/2007 par (gile)]
-
J'avais déjà cette fonction (peut-être même déjà publiée ici) je n'ai fait que la traduire avec un while pour le fun. J'ai retrouvé, c'était ici et j'en avais donné une autre version là, en fait j'avais pensé un temps à un "challenge" sur cr thème. [Edité le 20/9/2007 par (gile)]
-
SCU 3 points : point Y par défault ?
(gile) a répondu à un(e) sujet de Bred dans Pour aller plus loin en LISP
En ce qui concerne l'algorythme arbitraire, j'avais déjà tenté une explication. Voir ici et là. Je réitère donc. Le propos de l'algorythme arbitraire est de définir une méthode non équivoque pour déterminer un systéme de coordonnées à partir du seul vecteur normal (et unitaire) du plan d'un objet (sa direction d'extrusion : code DXF 210). Autrement dit, de déterminer une origine et deux vecteurs unitaires perpendiculaires au premier et perpendiculaires entre eux tout en respectant la "règle de la main droite". L'origine choisie est celle du SCG => tous les SCO ont pour origine le 0,0,0 du SCG. Pour le calcul des vecteurs, l'outil utilisé est le produit vectoriel. Le résultat du produit vectoriel de deux vecteurs non colinéaires est le vecteur perpendiculaire à ceux-ci et qui respecte la "règle de la main droite". http://img347.imageshack.us/img347/3500/normal3as.png Comme au départ il n'y a de connu qu'un vecteur (appelons le Zdir), il suffit de faire le produit vectoriel d'un vecteur choisi arbitrairement par le vecteur Zdir pour obtenir un premier vecteur perpendiculaire à Zdir qui sera Xdir (le vecteur directeur de l'axe des X). Dans le cas de l'algorythme arbitraire le vecteur choisi est le vecteur (0 0 1). Mais, comme dit plus haut, les vecteurs ne doivent pas être colinéaires, sinon leur produit vectoriel est le vecteur nul (voir la méthode de DidierAD dans le challenge parllèles). Il est donc décidé, arbitrairement encore, que si la valeur absolue des coordonnées x et y du vecteur Zdir est inférieure à 1/64 (0.015625) (c-a-d qu'il est très proche ou égal à (0 0 1) ou (0 0 -1)), le vecteur Xdir sera le résultat du produit de (0 1 0) et Zdir. Une fois le vecteur Xdir déterminé le vecteur Ydir sera le résultat du produit vectoriel de Zdir par Xdir. Ce qui, traduit en LISP, donne (avec les routines de calcul vectoriel vlen, vunit et v^v données dans le premier lien ci-dessus) ;; Calcul de Xdir avec l'agorythme arbitraire (if (and (() (setq xdir (vunit (v^v '(0 1 0) zdir))) (setq xdir (vunit (v^v '(0 0 1) zdir))) ) ;; Calcul de Ydir à parti des deux premiers (setq ydir (vunit (v^v zdir xdir))) ) ;; si Zdir n'est pas un vecteur unitaire, en faire un vecteur unitaire (if (/= (vlen zdir) 1) (setq zdir (vunit zdir)) ) Le même résultat peut être obtenu par l'expression : (mapcar '(lambda (v) (trans v zdir 0)) '((1 0 0) (0 1 0) (0 0 1))) [Edité le 20/9/2007 par (gile)] -
Un peu à la bourre !!! (defun test (lst / pts listt) (setq lst (mapcar '(lambda (x) (cons x 1)) (acad_strlsort lst))) (foreach pt lst (if (eq (vl-position (setq pts (cons (car pt) (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) (car pt))) lst))) )) listt ) nil ) (setq listt (cons pts listt)) ) ) (if listt (reverse listt)) ) Tout ça pour dire : A quand un nouveau challenge pas trop dur ??? :D A bientôt. Matt.
-
Salut ! Je ne sais pas si ce sujet a déjà été discuté, mais voilà : La commande joindre sur autocad 2008. Pour ceux qui ne connaissent pas, elle permet de "joindre des objets pour former un objet unique, sans coupure" (dixit l'aide). Bon évidemment pas tous les objets ! Ceux qui sont fermés, c'est pas vraiment la peine de les joindre.. Pour les polylignes, pas de problèmes, tout le monde connait la commande pedit + joindre. Pour les arcs non plus, le centre + une des extrémités des deux arcs en commun, et c'est parti. Par contre pour les lignes, là, je cale. Pour savoir si toutes les lignes sélectionnées sont parallèles, ça va. Par contre pour savoir si elles sont colinéaires, là, je donne ma langue à cadXP (ou en tout cas aux furieux de l'autolisp présents sur ce site :))... Et attention challenge !! Pas de Vlisp ! Autolisp pur ! Sinon ce sera trop facile à mon avis... Voilà ! Merci à vous de consacrer autant de temps à aider les autres ; en particulier Gile et Patrick_35... A bientôt ! Matt.
-
2 valeur supprimer la +grande ou +petite
lovecraft a répondu à un(e) sujet de lovecraft dans Débuter en LISP
bonjour, Gile, merci d'avoir regarder ma demande. On peut dire en quelques sorte que c'est un p'tit challenge. T'as bien compris ce que je voulais faire. donc j'ai un peu commencé, mais comme tu le sais je ne suis qu'un debutant ..... Voila ce que j'ai commencé a faire.(c'est pas encore ca) Mais si vous avez des améliorations je suis a votre ecoute, même pour les conseils. ;*********************************************************************** defun c:cmax() (setq sstext (ssget)) (setq i 1) (repeat (sslength sstext) (setq enttxt (ssname sstext i)) (setq bdenttxt (entget enttxt)) (setq enttxt1 (entnext enttxt)) (setq bdenttxt1 (entget enttxt1)) (setq txt1 (cdr (assoc 1 bdenttxt1))) (setq txt2 (cdr (assoc 1 bdenttxt))) (setq vtxt1 (atof txt1)) (setq vtxt2 (atof txt2)) (if ( (command "effacer" txtmax "" ) );fin du repeat );fin du defun ;******************************************************************** Merci -
Salut Patrick Je me demandais si on pouvait utiliser le moteur de rendu de 3DSmax avec nos modeles Archi 2008 ??? Sinon, j 'espère toujours tes cours avec impatience, je me mets sérieusement à Archi, pendant mes prochaines vacances Le challenge ....maîtriser Architecture en deux semaines !!! l 'espoir fait vivre ! @+
-
Un p\'tit challenge d\'été !?
(gile) a répondu à un(e) sujet de bonuscad dans Pour aller plus loin en LISP
Ce challenge ne semble pas bousculer les foules :exclam: Je livre quand même mes devoirs de vacances. Pour éviter de trop me laisser influencer, j'ai juste parcourru le code de Bonuscad et l'ai testé avant d'essayer de faire quelque chose de plus personnel. Il y a donc quelques différences : - l'utilisateur ne spécifie qu'une longueur approximative pour le motif. - celle-ci est remplacée par la division juste de la longueur totale la plus proche - la largeur du motif est calculée en multipliant cette longueur par un ratio (défaut : 1/3) - les motifs peuvent être dessinés "à cheval" sur les sommets de la polyligne d'origine - ils suivent la courbure des "polyarcs" (defun c:lw2motif (/ make-lst ent obj pt long AcDoc Space nor len ratio larg larg_d long_d pa ind clo blg seg dis nb long_f larg_f p_lst b_lst w_lst pline ) (vl-load-com) ;; Sous-routine pour la constitution des listes de sommets, de largeurs ;; et de bulges de la nouvelle polyligne (defun make-lst (pt l0 l1 b) (setq p_lst (cons pt p_lst) w_lst (cons (list ind l0 l1) w_lst) ) (or (= blg 0) (setq b_lst (cons (cons ind b) b_lst))) (setq ind (1+ ind)) ) ;; Saisie des données (while (not (and (setq ent (car (entsel))) (setq obj (vlax-ename->vla-object ent)) (= (vla-get-objectName obj) "AcDbPolyline") ) ) ) (setq pt (vlax-curve-getStartPoint obj)) (initget 7) (setq long (getdist pt "\nSpécifiez la longueur approximative du motif: " ) ) (initget 6) (or (setq ratio (getreal "\nSpécifiez le ratio largeur/longueur du motif : " ) ) (setq ratio (/ 1.0 3.0)) ) ;; Initialisation (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) nor (vlax-get obj 'Normal) len (vla-get-Length obj) long (/ len (fix (+ (/ len long) 0.5))) larg (* ratio long) larg_d larg long_d long pa 0 ind 0 ) (and (= (vla-get-Closed obj) :vlax-true) (setq clo T)) ;; Boucle sur chaque segment de la polyligne d'origine (repeat (fix (vlax-curve-getEndParam obj)) (setq blg (vla-GetBulge obj pa) seg (- (vlax-curve-getDistAtParam obj (1+ pa)) (vlax-curve-getDistAtParam obj pa) ) dis (- seg long_d) ) ;; Si le segment est plus court que la longueur de motif à dessiner (if (minusp dis) ;; Alors (progn (setq larg_f (* ratio (- long_d seg))) (make-lst (vlax-curve-getPointAtParam obj pa) larg_d larg_f blg ) (setq long_d (- dis) larg_d larg_f pa (1+ pa) ) ) ;; Sinon (progn (setq nb (fix (/ dis long)) long_f (rem dis long) ) ;; Premier motif (make-lst (vlax-curve-getPointAtParam obj pa) larg_d 0.0 (k*bulge blg (/ long_d seg)) ) ;; Motifs suivants (repeat nb (make-lst (vlax-curve-getPointAtDist obj (* long (- ind pa))) larg 0.0 (k*bulge blg (/ long seg)) ) ) ;; Dernier motif (if (zerop long_f) (setq long_d long larg_f 0.0 larg_d larg ) (progn (setq long_d (- long long_f) larg_f (* ratio long_d) larg_d larg_f ) (make-lst (vlax-curve-getPointAtDist obj (* long (- ind pa))) larg larg_f (k*bulge blg (/ long_f seg)) ) ) ) (setq pa (1+ pa)) ) ) ) ;; Création de la polyligne (or clo (setq p_lst (cons (vlax-curve-getEndPoint obj) p_lst)) ) (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (p) (setq p (trans p 0 nor)) (list (car p) (cadr p)) ) (reverse p_lst) ) ) ) ) (and clo (vla-put-closed pline :vlax-true)) (mapcar '(lambda (x) (vla-SetBulge pline (car x) (cdr x))) b_lst ) (mapcar '(lambda (x) (vla-Setwidth pline (car x) (cadr x) (caddr x))) w_lst ) (vla-put-Normal pline (vlax-3d-point nor)) (vla-put-Elevation pline (vla-get-elevation obj)) (princ) ) ;; K*BULGE ;; Retourne le bulge proportionnel au bulge de référence ;; Arguments : ;; b : le bulge ;; k : le rapport de proportion (entre les angles ou les longueurs d'arcs) (defun k*bulge (b k / a) (setq a (atan b)) (/ (sin (* k a)) (cos (* k a))) ) [Edité le 24/7/2007 par (gile)] -
Oui, c'est du Diesel, on peut l'adapter pour d'autres variables système acceptant les valeurs 1 ou 0 (pickfirst, ucsfollow, ucsortho, etc...) en remplaçant, dans la macro, pickadd par le nom de la variable. Pour ceux qui préfèrent le LISP (versions pleines) (setvar "PICKADD" (Boole 6 1 (getvar "PICKADD"))) voir les explications dans ce challenge.
-
ReBonjour Je sollicite encore votre aide et ce toujours pour des Textes / MTextes numériques car tout le monde ne dispose pas d'un MAP (ou CIVIL) ... pour thématiser les valeurs numériques C'est dur quand on est sur un simple AutoCAD ! :o Un exemple pour tous les Textes / MTextes dont la valeur est comprise entre : 0-3 : transfert sur le calque xxxx_0_3 4-9 : transfert sur le calque xxxx_4_9 10-19 : transfert sur le calque xxxx_10_19 etc Les Textes/MTextes NON COMPRIS dans les intervalles ne seront pas transférés ! A partir d'une table d'intervalle qui serait en DUR dans le programme Lisp donc modifiable facilement ! Qui qui va gagner ce petit challenge ? Le Decapode "coloriant Texte / MTexte"
-
Recherche/remplacer qui boucle
Patrick_35 a répondu à un(e) sujet de stephan35 dans Pour aller plus loin en LISP
Si ça devient un challenge ;) (defun @Macro_remplace_texte ($source $search $rempl / loc pos) (while (setq loc (vl-string-search $search $source pos)) (setq $source (vl-string-subst $rempl $search $source pos) pos (+ loc (strlen $rempl)) ) ) $source ) (@macro_remplace_texte "aaaaaapopopopoaaaa" "po" "iiiipo") --> aaaaaaiiiipoiiiipoiiiipoiiiipoaaaa (@Macro_remplace_texte "Tables d'écoutes" "'" "\'" ) --> "Tables d'écoutes" @+ -
Hello Voici un autre challenge (ou Routine Lisp à développer) que je ne sais pas résoudre ... Soit N polylignes 2D closes ou pas (d'au moins 3 sommets) : LWPOL , POL et Lissées ou Pas, Splinées ou Pas ... Sélection de ces N polylignes et reconstruction de toutes les polylignes nécessaires (en changeant le sens avec la routine R_PLINE de Gilles) pour CELLES qui tournent dans le sens des aiguilles de montre ! En clair je veux que toutes mes polylignes soient dans le sens TRIGONOMETRIQUE ! Routine R_PLINE.LSP de (gile) http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=10953#pid Merci d'avance de vos solutions ... Le Decapode
-
Yeah, ça c'est un vrai challenge :D
-
Dans ce fil, il y a eu des malentendus et la demande allait à l'encontre de l'éthique de CadXp. Si Ahmed avait mis son lisp en ligne, je n'aurais pas fait de réponse sur le forum (peut être en MP et encore), car il évidant que l'auteur voulait protéger son travail. Avant de faire quoique ce soit, j'ai fait des recherches sur le net, et je n'ai rien trouvé! J'ai donc considéré qu'il n'y avait plus de suivi sur cette application, que celle-ci était obsolète et ne porterait pas de préjudices (pas de nouvelle versions proposée pour les versions actuelles). Je reconnais que j'ai enfreins le travail d'autrui, mais pour moi seul Ahmed doit en supporter le caractère illégal. C'est à lui maintenant qu'il incombe de ne pas diffuser ce lisp détourné. Je ne cherche pas a me justifier, mais Ahmed ayant fait des remerciements en public (ce qu'il n'aurait pas du faire à mon avis, vu le caractère ambigüe de la demande), je me dois donc quelques explications. Ahmed, tu es certainement un gentil garçon, mais tu nous as mis Patrick et moi dans une situation malsaine. Indirectement, tu nous montre du doigt comme hacker, ce qu'on est point. Je pense que Patrick et moi avons relevé ceci comme un challenge, par passion et pour te rendre service, chose que je n'aurais pas faite si mes recherches avaient été fructueuses. JE NE REPONDRAIS PLUS A CE GENRE DE DEMANDE, pour m'éviter ce genre de situations inconfortable. Sans rancune tout de même, pour moi le sujet est clos!
-
je voulais vous remerciez pour l'aide que vous nous donnez. Donc comme vous le suggerez j'ai une p'tite demande a vous faire. Est ilpossible de lancer un nouveau challenge? le sujet serait: trier une liste de bloc avec un attribut (style numero du bloc) Pour ensuite avoir une nouvelle liste suivant l'attribut. Merci de votre aide. @plus
-
Bonjour, Didier as-tu besoin d'un lisp MNT ou c'est simplement pour le challenge (car sinon j'en ai récupéré un sur le site mais je ne sais pas s'il fonctionne).
-
Merci du compliment les fonctions ASSOC, MEMBER, MAPCAR n'ont pas les mêmes roles ; il n'est donc pas aisé de les comparer d'un point de vue optimisation ASSOC permet de trouver une sous liste par l'intermédiaire d'une cle (numérique ou chaine) dans une liste en arbre du type (setq l '((1 "Didier" "BTP") (2 "Krunch" "Meca") (3 "BonusCAD" "GIS"))) (assoc 2 l) retourne (2 "Krunch" "Meca") le temps d'exécution dépend de la position de la sousliste dans la liste principale ; au pire, on peut compter n unité de temps (n = nombre de sous listes dans la liste) : pour descendre jusqu'à la clé MEMBER permet souvent de tester l'existence d'un élément dans une liste mais aussi de rtourner la fin d'une liste à partir de cet élément ; (setq l '(1 2 3 4 5 6 7 8 9)) (member 5 l ) retourne (5 6 7 8 9) le temps d'exécution est du même ordre que celui de assoc il dépend de la position de l'élément dans la liste ; au pire n unité de temps (avec n le nombre d'éléments de la liste) MAPCAR sert à appliquer une fonction à tous les éléments d'une ou plusieurs listes et retourne la liste des résultats. il me semble que giles (ou Patrick_35) a écrit un "papier très instructif sur MAPCAR dans le fil d'un récent challenge mais je ne l'ai pas retrouvé pour mettre un lien dessus MAPCAR exécute la fonction demandée autant de fois qu'il y a d'élément dans la plus courte des listes qui lui sont proposées le temps d'exécution dépend bien entendu de la fonction à exécuter à titre personnel, je voue à MAPCAR une véritable dévotion car elle est d'une puissance fabuleuse dans le traitement des listes. FOREACH permet d'exécuter n fois (n = nombre d'éléments d'une liste) un série d'instructions ou une fonction ; le temps d'exécution dépend des instructions ou de la fonction à exécuter à la différence de MAPCAR, FOREACH retourne ce qu'a retourné la dernière instruction exécutée et non pas une liste Quand aux fonctions vl-*, elles ont chacune leur utilité , soit pour ne garder que certaines valeur d'une liste soit pour vérifier des propriétés des éléments d'une liste elles sont toutes associées à une fonction dont le role est de retourner T ou NIL le temps d'exécution de ces fonctions VL dépend essentiellement du temps d'exécution de la fonction associée qui est répétée en général n fois (n étant le nombre d'éléments de la liste). Encore une fois, il est difficile de comparer ces différentes fonctions car elles ont des rôles différents, ce que je peux te conseiller c'est de les essayer chacune avec des exemples simples afin de bien comprendre ce qu'elles fournissent et à partir de quoi ; et lorsque l'occasion se présentera tu pourras choisir celle qui te convient le mieux VLISP et c'est sa force permet d'obtenir les mêmes résultats avec des écritures différentes, Finalement, le temps d'exécution n'a d'importance que quand les calculs sont très répétitifs, La concision du code fait souvent frémir de bonheur les vieux lispeurs, mais je t'avoue que parfois lorsque je relis mes anciens codes avec 3 mapcar dans la même ligne, je regrette de ne pas avoir pris le temps de mettre quelques commentaires.. [Edité le 28/5/2007 par Didier-AD]
-
C'est vrai, on se calme, c'est juste un exercice pour un challenge, il ne s'agit pas de refaire un logiciel comme COVADIS Effectivement, dans ce genre de calcul, en C, c'est beaucoup plus rapide qu'en LISP ; Il ne s'agit pas non plus de pouvoir traiter des grosses quantités de points, juste se prendre un peu la tête sur la gestion des listes de données. J'avais fait un essai il y a fort longtemps et j'ai égaré le code ; à l'époque, il n'y avait pas les fonctions performantes de Visual Lisp comme vl-remove ou vl-member-if peut-être que ce n'est pas si déplorable que çà en temps.
-
Suite à ce challenge en LISP, je propose aux "LTsiens dieselistes" un moyen pour faire des boutons bascules sur des variables système. Par exemple, la macro suivante active UCSFOLLOW si elle était inactive ou l'inverse (commande transparente). 'ucsfollow;$M=$(xor,$(getvar,ucsfollow),1);
-
Projection de LWPOLYLINE simple sur 3Dface
bonuscad a répondu à un(e) sujet de bonuscad dans Pour aller plus loin en LISP
Euh! Je veux bien, mais c'est du brut de décoffrage pour répondre à MON besoin immédiat. (aucune élégance dans le code et utilisation de sous routine tierce qui sont pas de moi) Si vous voulez en faire un challenge pour qu'elle soit plus générale d'utilisation, pourquoi pas! Je n'ai pas trop de temps en ce moment pour faire cela. Donc au départ j'ai une dalle en PMAILLE 3D (la routine la décompose en 3Dface, mais je ne sauvegarde pas mon dessin, mais fais un copier-coller du résultat dans un autre dessin) et des LWPOLYLINE (SANS arcs) ayant une épaisseur constante, tout ça dans le SCG. Les calques que je veux traiter sont aussi spécifique à mon dessin, mais ca c'est facile à modifier. Cette routine + utilisation de PEDIT3D de gilles va me permettre d'arriver au résultat que je souhaite avec le minimum de manipulation par la suite. (je pense "mailler" entre mes polyligne3d avec mon module "trinod.lsp" par la suite pour qu'elle soient visible en rendu, pas tester encore!) (defun punktinpolylinie (pointinquestion point_list / ) (if (equal 0.0 (pipwinkelsumme pointinquestion point_list) 0.0001) nil t ) ) (defun pipwinkelsumme (pointinquestion point_list / count p1 p2 scheitel winkeleins winkelzwei) (setq winkeleins 0.0 scheitel (car point_list) count 1 ) (while (< 1 (length point_list)) (setq p1 (car point_list) p2 (cadr point_list) point_list (cdr point_list) winkelzwei (pipwinkelhilfe pointinquestion p1 p2) winkelzwei (if (< 180.0 winkelzwei) (- winkelzwei 360.0) winkelzwei) winkeleins (+ winkeleins winkelzwei) ) (setq count (1+ count)) ) (setq winkelzwei (pipwinkelhilfe pointinquestion p2 scheitel) winkelzwei (if (< 180.0 winkelzwei) (- winkelzwei 360.0) winkelzwei) ) (+ winkeleins winkelzwei) ) (defun pipwinkelhilfe (pointinquestion p1 p2 / alpha beta) (setq beta (angle pointinquestion p1) alpha (angle pointinquestion p2) alpha (- alpha beta) ) (if (< alpha 0) (setq alpha (+ (* 2 pi) alpha)) ) (* (/ (float alpha) pi) 180.0) ) (defun c:lw2pl3d ( / ) (if (not bdx) (progn (setq jsm (ssget "_X" '((0 . "POLYLINE") (8 . "MAILLAGE3D") (70 . 64)))) (vlax-invoke-method (vlax-ename->vla-object (ssname jsm 0)) 'GetBoundingBox 'pt1 'pt2 ) (setq bdx (list (mapcar 'vlax-safearray->list (list pt1 pt2) ) ) ) (setq bdx (mapcar '(lambda (funcs) (mapcar '(lambda (func) (apply func bdx)) funcs ) ) '((caar cadar)(caadr cadar)(caadr cadadr)(caar cadadr)) ) ) (command "_.explode" (ssname jsm 0)) ) ) (command "_.zoom" "_window" (car bdx) (caddr bdx)) (princ "\nChoisir la polyligne 2D") (setq js_lw (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (cond (js_lw (setvar "cmdecho" 0) (setq dxf_lw (entget (ssname js_lw 0)) vla_obj (vlax-ename->vla-object (cdar dxf_lw)) dxf_elw (cdr (assoc 40 dxf_lw)) loop 0 ) (vla-Offset vla_obj (/ dxf_elw 2.0)) (repeat 2 (setq dxf_lw (entget (entlast)) dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lw)) all_pt nil ) (while dxf_10 (if (cdr dxf_10) (if (setq rslt (vl-remove nil (mapcar '(lambda (x y) (inters (car dxf_10) (cadr dxf_10) x y T)) (cons (last bdx) bdx) bdx))) (if (and (punktinpolylinie p1 bdx) (not (equal (car dxf_10) (car rslt) 1E-12))) (setq p1 (car dxf_10) dxf_10 (cons p1 (cons (car rslt) (cddr dxf_10)))) (setq p1 (car rslt)) ) (setq p1 (car dxf_10)) ) ) (setq js (ssget "_C" (list (- (car p1) 25.0) (- (cadr p1) 25.0)) (list (+ (car p1) 25.0) (+ (cadr p1) 25.0)) '((0 . "3DFACE") (8 . "MAILLAGE3D"))) p1 (trans p1 1 0) p1 (list (car p1) (cadr p1)) n -1 lst_px nil ) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n)))) lst_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (caddr lst_pt) (cadddr lst_pt)) (setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt))) (setq lst_pt (append lst_pt (list (car lst_pt)))) ) (if (punktinpolylinie p1 lst_pt) (progn (command "_.ucs" "_3point" "_none" (car lst_pt) "_none" (cadr lst_pt) "_none" (caddr lst_pt)) (setq p_10 (trans (list (car p1) (cadr p1) 1000.0) 0 1) p_11 (trans (list (car p1) (cadr p1) 0.0) 0 1) p10_2d (list (car p_10) (cadr p_10) 0.0) p11_2d (list (car p_11) (cadr p_11) 0.0) p_int (trans (inters p10_2d p11_2d p_10 p_11 nil) 1 0) lst_px (cons p_int lst_px) ) (command "_.ucs" "_world") ) ) ) (if lst_px (setq all_pt (append lst_px all_pt)) ) ) ) (setq dxf_10 (cdr dxf_10)) ) (cond (all_pt (setq pt_all (list (car all_pt))) (while (cdr all_pt) (setq p1 (car all_pt) p2 (cadr all_pt) js (ssget "_F" (list p1 p2) '((0 . "3DFACE") (8 . "MAILLAGE3D"))) p1 (trans p1 1 0) p2 (trans p2 1 0) p1 (list (car p1) (cadr p1)) p2 (list (car p2) (cadr p2)) n -1 lst_px nil ) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n)))) lst_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (caddr lst_pt) (cadddr lst_pt)) (setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt))) (setq lst_pt (append lst_pt (list (car lst_pt)))) ) (while (cdr lst_pt) (setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T)) (if px (progn (setq px (inters (list (car px) (cadr px) 0.0) (list (car px) (cadr px) 100.0) (car lst_pt) (cadr lst_pt) nil)) (if (and px (not (member px lst_px))) (setq lst_px (cons px lst_px)) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) (if lst_px (progn (setq new_lst nil) (while lst_px (setq l (mapcar '(lambda (x) (distance x p1)) lst_px)) (setq el (nth (- (length lst_px) (length (member (apply 'min l) l))) lst_px)) (setq lst_px (vl-remove el lst_px) new_lst (cons el new_lst) ) ) (setq pt_all (append (list (cadr all_pt)) new_lst pt_all)) ) (setq pt_all (append (list (cadr all_pt)) pt_all)) ) ) (T (setq pt_all (append (list (cadr all_pt)) pt_all))) ) (setq all_pt (cdr all_pt)) ) (command "_.3dpoly") (foreach el pt_all (command "_none" (trans el 0 1))) (command "") (entdel (cdar dxf_lw)) ) (T (princ "\nAucune 3DFACE trouvée!")) ) (if (not (zerop (rem (setq loop (1+ loop)) 2))) (vla-Offset vla_obj (- (/ dxf_elw 2.0))) ) ) (setvar "cmdecho" 1) ) ) (prin1) ) NB: Le dessin d'essai que j'avais fourni en exemple ne fonctionne pas pour cette routine car j'avais déjà décomposé ma maille. -
Pas d'accord avec toi, Patrick, dans le cadre d'un challenge de quelque niveau que ce soit, il n'y a pas de réponse idiote, juste des tentatives qu'on peut juste qualifier d'optimisables éventuellement mais je pense que tes propos ont juste dépassé ta pensée cordialement
-
Comme pour moi avec un niveau intermédiaire ! J'ai bien deux autres propositions de ce niveau, mais je ne suis pas certain qu'il y a beaucoup de réponses. Je pense que l'on a affaire soit à des gros débutants pour lequel c'est trop difficile ou les pros qui répondent en 5mn. Doser le niveau et la difficulté n'est pas aisé. :mad2: Je pense que le plus simple, c’est que les débutants proposent un challenge à leurs niveaux pour lequel d’ailleurs ils ne peuvent pas répondre, et aux autres de répondre afin que lesdits débutants puissent analyser les réponses, essayer de comprendre, et surtout, n’hésitant pas à poser des questions s’ils ne comprennent telle ou telle fonction ou la manière dont fonctionne la réponse. @+
-
Bon, Il semble que je me sois "planté" avec ce challenge, plus de 260 visites ce jour, et seulement deux tentatives de réponses. L'exercice est peut-être trop difficile pour ceux qui s'estiment "débutants", ou dénigré par ceux qui auraient pu s'y pencher. L'idée que j'avais derrière la tête était d'amener à découvrir/comprendre la fonction mapcar. Chez moi cette découverte a été un grand pas dans ma compréhension du LISP et des traitements de listes. Je vais tenter de débrousailler un peu pour aider ceux qui voudrait "améliorer la routine proposée par lovecraft. mapcar fait passer comme argument à une fonction tous les éléments d'une ou plusieurs listes et retourne une liste dont chaque élément est le résultat de ces évaluations. Exemple : (mapcar '1+ '(3 4 5)) La fonction est 1+ qui incrémente de 1 l'argument qui lui est passé. Chaque élément de la liste (3 4 5) sera donc passé comme argument de la fonction 1+ ce qui équivaudrait à faire : (list (1+ 3) (1+ 4) (1+ 5)) et retourne donc (4 5 6) avec plusieurs listes, tous les éléments de même rang dans chaque liste sont passés comme argument à la fonction, ce qui permet, entre autre, d'ajouter des points (listes de coordonnées) Exemple : (mapcar '+ '(1 2 3) '(4 5 6) '(7 8 9)) ce qui équivaut à : (list (+ 1 4 7) (+ 2 5 8) (+ 3 6 9)) et retourne donc (12 15 18) En utilisant la fonction mapcar dans la routine donné par Lovecraft, outre le fait qu'elle serait plus courte et plus élégante, elle pourrait fonctionner aussi bien avec des points 2d (x y) qu'avec des points 3d (x y z). En espérant avoir éclairé quelques lanternes, à vos clavier ... Prochain épisode, l'utilisation de fonctions lambda avec mapcar ...
-
A droite ou à gauche ?
Didier-AD a répondu à un(e) sujet de Didier-AD dans Pour aller plus loin en LISP
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
