Rechercher dans la communauté
Affichage des résultats pour « challenge » dans sujets.
-
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)] -
Bonjours à tous. Je voulais réaliser un lisp un petit peu "fun", mais qui pourrais être aussi utile. (une sorte de type de ligne, mais invariable) J'ai déjà commencé aujourd'hui et suis arrivé à un certain résultat. Le mieux est de l'essayer pour vous rendre compte de ce que je veux faire. (appliquez le sur un rectangle) J'en profite donc pour lancer un challenge (d'été), afin de l'améliorer et avoir un résultat correct pour toutes les LwPolylignes (arc). Au départ je voulais pouvoir l'appliquer à tout les objets curvilignes, mais ça complique pas mal les choses. Je pense que la partie (entmake) n'as pas besoin d'être reprise (sous réserve...) C'est plutôt la liste l_42, que je réserve pour la suite pour essayer de mettre le motif courbé. Celui-ci est pour l'instant traitée en segment droit. Le motif pourra être changé, on peut envisager un traitement de motif différent (losange, croix, insertion de segment non épais...) Mais déjà pour la mise au point, on peut garder ce motif. Donc pour ceux que l'idée interresse, les propositions sont attendues...et j'expliquerais les variables employées si vous ne comprenez pas à quoi elles servent. NB: Les points d'appuis originaux doivent êtres conservés. (defun c:lw2motif ( / ent obj_valx dxf_obj pt_first ep_lw d_inc pt_snd nb_vtx count l_pt lg_inc start_ep end_ep delta lg_vtx l_40 l_41 l_42) (vl-load-com) (while (not (setq ent (entsel "\nSelectionner un objet: ")))) (setq obj_vlax (vlax-ename->vla-object (car ent)) dxf_obj (entget (car ent))) (cond ((eq (cdr (assoc 0 dxf_obj)) "LWPOLYLINE") (setq pt_first (vlax-curve-getStartPoint obj_vlax)) (initget 71) (setq ep_lw (getdist pt_first "\nEpaisseur du symbole: ")) (initget 71) (setq d_inc (getdist pt_first "\nLongueur du symbole: ")) (setq pt_snd (vlax-curve-getPointAtParam obj_vlax 1) nb_vtx (fix (vlax-curve-getEndParam obj_vlax)) count 0 l_pt (list (cons 10 pt_first)) l_40 (list (cons 40 ep_lw)) l_41 (list (cons 41 0.0)) ; l_42 (list (cons 42 (vlax-invoke obj_vlax 'GetBulge count))) l_42 (list (cons 42 0.0)) lg_inc 0.0 start_ep ep_lw end_ep 0.0 delta 0.0 ) (repeat nb_vtx (setq lg_inc (vlax-curve-getDistAtParam obj_vlax count) lg_vtx (vlax-curve-getDistAtParam obj_vlax (1+ count)) ) (while (< (+ lg_inc d_inc) lg_vtx) (if (< (+ lg_inc d_inc) lg_vtx) (setq start_ep (if (zerop delta) ep_lw end_ep) end_ep 0.0 delta 0.0 ) (setq start_ep ep_lw delta (- lg_vtx lg_inc) end_ep (* (/ ep_lw d_inc) delta) ) ) (setq l_pt (cons (cons 10 (vlax-curve-getPointAtDist obj_vlax (setq lg_inc (+ lg_inc d_inc)))) l_pt) l_40 (cons (cons 40 start_ep) l_40) l_41 (cons (cons 41 end_ep) l_41) ; l_42 (cons (cons 42 (vlax-invoke obj_vlax 'GetBulge count)) l_42) l_42 (cons (cons 42 0.0 )l_42) ) ) (setq count (1+ count) pt_first (vlax-curve-getPointAtParam obj_vlax count) pt_snd (vlax-curve-getPointAtParam obj_vlax (1+ count)) l_pt (cons (cons 10 pt_first) l_pt) l_40 (cons (cons 40 start_ep) l_40) l_41 (cons (cons 41 end_ep) l_41) ; l_42 (cons (cons 42 (vlax-invoke obj_vlax 'GetBulge count)) l_42) l_42 (cons (cons 42 0.0 )l_42) ) ) (setq l_pt (reverse l_pt) l_40 (reverse l_40) l_41 (reverse l_41) l_42 (reverse l_42) ) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (assoc 8 dxf_obj) (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256)) (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER")) (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1)) (cons 100 "AcDbPolyline") (cons 90 (length l_pt)) (cons 70 (if (zerop (boole 1 (rem (cdr (assoc 70 dxf_obj)) 128) 1)) (boole 1 (cdr (assoc 70 dxf_obj)) 128) (1+ (boole 1 (cdr (assoc 70 dxf_obj)) 128)) ) ) (cons 38 (if (assoc 38 dxf_obj) (cdr (assoc 38 dxf_obj)) 0.0)) (cons 39 (if (assoc 39 dxf_obj) (cdr (assoc 39 dxf_obj)) 0.0)) ) (apply 'append (mapcar '(lambda (x10 x40 x41 x42) (append (list x10 x40 x41 x42)) ) l_pt l_40 l_41 l_42 ) ) (list (assoc 210 dxf_obj)) ) ) ) (T (princ "\nN'est pas une polyligne optimisée!") ) ) (princ) )
-
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" @+ -
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
-
Non, c'était juste un challenge, d'ailleurs, mes souvenirs de l'algorythme Delaunay étaient très vagues quand j'ai lancé ce challenge.... La preuve : j'ai écrit la routine selon l'algorythme décrit en début de challenge, çà donne çà : http://xs216.xs.to/xs216/07225/Image6.jpg Pas terrible hein ? J'ai d'abord cru à une erreur de programmation et puis je suis allé vérifier l'algorythme sur Internet et c'est un peu plus complexe qu'annoncé au début la même liste de points devrait donner ceci http://xs216.xs.to/xs216/07225/Image7.jpg mais çà m'a piqué au vif et j'y reviendrai avec la routine et des explications
-
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.
-
Bon Matin Magnifique challenge, si quelqu'un arrive à "pondre" un algo PERFORMANT sur des milliers de points en Lisp, ce sera magnifique ! On peut trouver des routines sur le Web, mais elles sont très lentes en général dès que le nombre de points est plus ou moins important ... La routine en Lisp / V-Lisp / VBA doit pouvoir fonctionner sur AutoCAD / MAP / Autodesk Architectural Desktop et produire soit un maillage de 3D Faces (PMesh), soit un ensemble de N 3DFaces Le challenge complèmentaire : A partir de ces triplets de points XYZ produire N polylignes 2D sur des calques différents, à des élévations différentes qui seraient en fait les courbes de niveaux espacées de 5 / 10 / etc m. C'est un paramètre (Elévation) à demander ainsi que le nombre de calques différents : - Courbes secondaires sur le calque CN_1 - Courbes principales de 10 en 10 par exemple sur le calque CN_2 - Super courbes de 50 en 50 par exemple sur le calque CN_3 A mon avis, 3 calques de courbes d eniveaux sont largement suffisants ! Le Decapode
-
Celui là, c'est pour les champions et le résultat pourra être placé dans les routines LISP il s'agit de modéliser un terrain à partir de points topographiques XYZ un des algorythmes utilisables est l'algorythme de Delaunay expliqué brièvement sur l'image ci dessous http://xs215.xs.to/xs215/07221/Image5.jpg petit truc pour aider au début : le premier triangle peut être aisément remplacé par un rectangle qui englobe l'ensemble des point et qu'on partage immédiatement en 2 triangles selon une diagonale. Petit (gros) bonus pour les acharnés : c'est plus beau de gérer les triangles en mémoire dans une liste et de ne tracer l'ensemble des 3Dfaces qu'à la fin... ci dessous une liste de points 3D (261.341 151.864 118.208) (261.341 231.435 109.913) (261.341 209.625 108.910) (261.341 187.688 111.296) (261.341 165.778 113.907) (261.341 143.880 116.624) (244.612 132.933 108.374) (243.423 154.766 106.772) (241.139 176.734 106.750) (238.306 198.775 107.633) (235.467 220.854 109.054) (233.168 242.068 117.193) (231.955 262.027 127.368) (217.871 252.288 122.565) (220.615 231.858 112.188) (209.367 221.134 107.400) (214.361 198.875 104.777) (219.337 176.621 102.725) (223.547 154.569 101.787) (216.735 132.933 103.892) (234.937 143.767 103.828) (203.039 154.269 104.912) (207.431 132.933 106.385) (197.267 176.411 103.857) (205.387 187.703 103.276) (187.490 210.195 103.050) (193.993 232.177 108.430) (189.535 252.556 117.659) (202.315 262.170 126.142) (173.809 262.194 117.792) (164.878 242.899 106.257) (171.578 221.549 101.145) (178.817 198.952 101.696) (186.007 176.286 102.897) (192.557 154.095 104.319) (191.341 132.933 102.500) (159.324 262.036 114.489) (147.683 252.928 109.743) (142.111 232.567 105.030) (151.193 209.795 100.863) (160.463 186.318 98.751) (169.390 163.156 97.382) (177.457 141.252 96.924) (172.529 129.088 98.047) (165.095 146.289 98.761) (155.429 169.761 100.321) (145.163 194.366 102.781) (134.813 218.814 105.983) (124.887 241.373 112.746) (115.932 260.565 121.039) (109.996 241.818 119.556) (120.270 221.286 111.719) (131.002 198.100 106.516) (141.817 174.008 102.930) (152.343 150.337 100.258) (162.230 128.369 98.760) (160.981 114.926 97.683) (149.770 131.893 98.662) (139.007 154.257 101.776) (127.937 177.594 106.119) (116.761 200.720 111.263) (105.668 222.123 118.729) (84.476 229.970 128.232) (86.329 201.978 120.898) (101.851 202.030 116.291) (104.356 171.573 110.850) (110.269 160.843 108.148) (122.011 139.311 103.400) (133.694 118.449 99.885) (145.386 100.825 98.046) (131.700 98.445 100.217) (119.510 121.967 102.855) (136.209 135.679 100.425) (107.406 142.350 106.768) (95.226 162.809 111.760) (82.834 182.555 117.777) (70.107 200.654 124.910) (74.028 219.401 128.642) (53.139 198.237 128.582) (49.695 179.781 124.721) (66.612 181.718 121.429) (70.129 154.294 115.697) (83.388 136.275 111.165) (96.505 117.955 107.528) (109.602 100.336 104.789) (123.860 83.493 102.695) (108.510 85.160 105.805) (94.972 102.330 107.748) (80.299 120.882 110.578) (67.467 136.623 113.921) (53.483 153.237 118.530) (32.264 177.067 128.000) (235.681 132.933 104.717) Et normalement à la fin il faut enlever ce qui reste du premier triangle
-
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);
-
Bonsoir Cette fois ci, c'est un challenge je l'ai trouvé sur un autre site, mais je le trouve fort intéressant, instructif et utile Il s'agit d'effacer tous les textes/mtextes vides dans un dessin @+
-
La réponse de bonuscad est intéressante, en plus de mapcar, elle utilise la fonction apply, autre fonction majeure pour le traitement des listes. Je vais pour ma part, essayer de finir mon exposé sur l'utilisation de mapcar pour résoudre ce challenge. On avait vu ici comment utiliser mapcar avec une fonction LISP prédéfinie (+). Le problème que nous avons à résoudre demande plus qu'une simple addition de tous les termes de même niveau de chaque point, il faut ensuite diviser chaque résultat par 3. Or, comme il n'existe pas de fonction LISP prédéfinie qui fasse cela, nous allons en créer une. On peut imaginer de faire une autre fonction nommée (defun) qui retournerait la moyenne de 3 nombres : (defun moyenne3 (n1 n2 n3) (/ (+ n1 n2 n3) 3) ) Et ensuite utiliser cette nouvelle fonction avec mapcar : (defun moyenne3 (n1 n2 n3) (/ (+ n1 n2 n3) 3) ) (defun cen-grav (p1 p2 p3) (mapcar 'moyenne3 p1 p2 p3) ) Cette solution exige que la routine moyenne3 soit chargée pour que cen-grav puisse aboutir. C'est celle que j'adopte dans le cas de routines servant dans plusieurs autres LISP. La fonction mapcar accepte, comme on l'a vu, les fonctions prédéfinies, les fonctions définies par l'utilisateur (defun) elle accepte aussi les fonctions anonymes : lambda Une fonction lambda n'a pas de nom et retourne son résultat là où elle est définie. Comme un defun elle peut nécessiter des arguments. Dans le cas présent, la fonction lambda remplacerait la fonction moyenne3 : (defun cen-grav (p1 p2 p3) (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3)) p1 p2 p3) ) Voilà, c'est lidée que j'avais derrrière la tête en lançant ce challenge, faire découvrir à ceux qui ne les connaissaient pas ces fonctions, si faciles à comprendre mais puissantes dans le traitement des listes (tout comme la fonction apply utilisée par Bonuscad).
-
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
