Rechercher dans la communauté
Affichage des résultats pour « challenge » dans sujets.
-
Salut, Ces challenges ne sont pas nouveaux, il existent sur TheSwamp depuis belle lurette et je me souviens m'y être frotté à des pointures de l'époque (ElpanovEvgeniy, Mickael Puckett, Vovka, Tim Willey, Kerry Brown, ...). On y a même vu arriver et progresser le talentueux Lee Mac. Je me suis beaucoup amusé et j'ai énormément appris avec ces exercices ludiques. Le regretté Patrick_35 les avait importé sur CADxp en 2007 (voir ici) et, depuis on a essayé d'en lancer de nouveaux mais avec moins de succès que sur TheSwamp. Une recherche avec "challenge" dans les forums LISP de CADxp donne quand même 3 pages de résultats. Il y a toujours moyen de s'entrainer avec ces sujets si on s'efforce de cherche avant de regarder les solutions...
-
Les challenges sont simples, l'anglais ne devrait pas être un repoussoir (moi même je ne parle toujours pas anglais, je ne le déchiffre que dans les grandes lignes en général je ne fais de proposition que si les exemples me semble clair). Ici aussi il y a beaucoup de challenges certains faciles d'autres un peu moins, même si ils ne sont pas regroupé dans un même fil de discussion avec une petite recherche on arrive à mettre la main dessus. D'une manière général dans un challenge ce qui compte c'est de les chercher, cela permet de mieux comprendre les réponses apportés, les lires sans avoir planché dessus au préalable n'a pas grand intérêt.. Les tenter n'obligent pas forcément à poster une réponse mais permet de s'exercer/réviser. Salutations Bruno
-
[Résolu] Petit lisp pour "sortir" un chiffre d'une chaine.
Luna a répondu à un(e) sujet de DenisHen dans Débuter en LISP
Coucou, J'avais déjà une fonction en stock pour chat 🙂 ; []-----------------------[] Wildcard-trim []-----------------------[] ; ;--- Date of creation > 10/12/2021 ; ;--- Last modification date > 10/12/2021 ; ;--- Author > Luna ; ;--- Version > 1.0.0 ; ;--- Class > "BaStr" ; ;--- Goal and utility of the main function ; ; When used for functions (vl-string-*-trim), lists all the characters corresponding to the specified pattern in the form of a list from the 256 ; ; characters present in the ASCII table. ; ; ; ;--- Declaration of the arguments ; ; The function (Wildcard-trim) have 1 argument(s) : ; ; --• w > correspond to the pattern that each character needs to match ; ; (type w) = 'STR | Ex. : "#", "@", "~#", ".,#", ... ; ; ; ;--- Return ; ; The function (Wildcard-trim) returns a list of characters (1 single character per string) whose characteristics correspond to the wildcard ; ; specified in argument (see wcmatch for the Wild-Card Characters). ; ; Ex. : (Wildcard-trim "#") returns ("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "²" "³" "¹") ; ; (Wildcard-trim "@") returns ("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" ; ; "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" ; ; "ƒ" "Š" "Œ" "Ž" "š" "œ" "ž" "Ÿ" "ª" "µ" "º" "À" "Á" "Â" "Ã" "Ä" "Å" "Æ" "Ç" "È" "É" "Ê" "Ë" "Ì" "Í" "Î" ; ; "Ï" "Ð" "Ñ" "Ò" "Ó" "Ô" "Õ" "Ö" "Ø" "Ù" "Ú" "Û" "Ü" "Ý" "Þ" "ß" "à" "á" "â" "ã" "ä" "å" "æ" "ç" "è" "é" ; ; "ê" "ë" "ì" "í" "î" "ï" "ð" "ñ" "ò" "ó" "ô" "õ" "ö" "ø" "ù" "ú" "û" "ü" "ý" "þ" "ÿ") ; ; ; ;--- Historic list of the version with their modification status ; ; +------------+----------------------------------------------------------------------------------------------------------------------------------+ ; ; | v1.0.0 | Creation of the function | ; ; +------------+----------------------------------------------------------------------------------------------------------------------------------+ ; ; ; (defun wildcard-trim (w / i lst a) (repeat (setq i 256) (if (wcmatch (setq a (chr (setq i (1- i)))) w) (setq lst (cons a lst)) ) ) lst ) Du coup pour répondre au challenge, je donnerai cette version : (vl-string-trim (apply 'strcat (wildcard-trim "~#")) str) Évidemment, avec la fonction (vl-string-trim) cela permet uniquement de supprimer les caractères en partant de la gauche et de la droite, jusqu'à ce qu'un caractère autorisé soit trouvé. Autrement dit, pour une chaîne de caractère telle que (setq str "ma80cm") ;; ou (setq str "Surface = 42.23m (+NGF)") ;; etc... On obtient respectivement les résultats : "80" ;; ou "42.23" Mais comme le souligne @bonuscad, dans le cas d'un nombre négatif, le moins est supprimé donc il y a une perte d'information dans ce cas-ci. Autre limite : dans le cas où il y a deux valeurs numériques dans une même chaîne de caractères, comme par exemple (setq str "Value = -543.1530054 (equals to 2u)") (vl-string-trim (apply 'strcat (wildcard-trim "~#")) str) returns "543.1530054 (equals to 2" Bref, cela réponds à un problème simple dans les conditions établies, mais cela possède ses propres limites tout de même si l'on étend son utilisation en dehors des conditions actuelles. Par contre, les nombres décimaux sont conservés correctement 😉 Bisous, Luna -
Salut, Très bonne initiative @didier. De mon côté, je suis un indécrottable conservateur (dans ce domaine du moins) et je dois avouer ne pas avoir creusé plus que ça l'utilisation VS Code avec AutoLISP*, j'ai trop d'habitudes avec le VLIDE**, principalement les fonctions de débogage et la possibilité tester des expressions dans la console. À mon sens, la véritable force d'AutoLISP, c'est son étroite intégration à AutoCAD et le fait de devoir charger un fichier .lsp dans VS Code pour pouvoir l'utiliser comme débogueur a été rédhibitoire pour moi. En plus, je ne fais plus vraiment de LISP si ce n'est pour aider sur les forums ou répondre à un challenge et dans ces cas, je n'ai pas envie d'ouvrir VS Code en plus d'AutoCAD. @JPhil, Programmer avec le bloc-note (que ce soit en LISP ou autre) c'est un peu comme faire la cuisine en s'interdisant de gouter ou humer le plat avant qu'il ne soit complètement terminé. J'ai appris ce que je connais en testant, testant et testant encore des bouts de code et c'est tellement plus facile avec AutoLISP qu'avec d'autres environnements que je trouve que se priver d'un IDE, c'est carrément masochiste. * je l'utilise avec F# hors AutoCAD. ** dont je pense qu'il me survivra comme tant chose dont Autodesk a annoncé une fin plus ou moins proche
-
Déterminer si un bloc se trouve à gauche ou à droite d'une polyligne
JPhil a répondu à un(e) sujet de JPhil dans Pour aller plus loin en LISP
@didier, Actuellement, il y a deux blocs qui visuellement sont les mêmes, juste le nom du bloc qui change et la rotation. Donc forcément dans certains coins, il y a le "mauvais" bloc et comme il y a des données qui sont liés avec une base de données externes, c'est difficile de faire un ménage rapide sans mettre le foutoir. Hors, un seul bloc aurait suffit en appliquant la rotation à l'endroit où il faut, avec une gestion de l'évolution plus souple. N'étant pas là au début de ce projet (pas loin de 10 ans), je vois des erreurs de choix qui fait que le besoin en interne a évolué mais pas le programme qui lui n'est plus assez souple pour encaisser tout ça. Donc oui, seulement un seul bloc, l'interroger afin qu'il nous donne sa position. J'ai conscience que sur le papier c'est super facile, mais à structurer c'est une autre paire de manche. Un joli challenge en fait. @Luna, Si je reprends ton exemple de donnée étendue. J'applique ceci sur une polyligne (dont je peux inverser le sens à tout moment parce que ça me fait plaisir) : ((lambda (key value / crv val) (setq crv (car (entsel "\nSelect polyline : "))) (if (null (setq val (vlax-ldata-get crv key))) (setq val (vlax-ldata-put crv key value)) val ) )) Avec 'key' dont la valeur serait "Nom", et 'value' dont la valeur serait "section 1 voie 1". J'applique la même procédure sur un bloc de signalisation : ((lambda (key / crvb value val) (setq crv (car (entsel "\nSelect bloc de signalisation : "))) (setq value (car (entsel "\nSelect polyline de liaison : "))) (if (null (setq val (vlax-ldata-get crv key))) (setq val (vlax-ldata-put crv key value)) val ) )) Avec 'key' dont la valeur serait "Chemin", et 'value' dont la valeur serait le nom de l'entité polyligne afin de permettre de créer une liaison. Donc si j'ai bien compris, même si je renomme "section 1 voie 1" en "truc mumuche", le bloc signalisation sera lié à la polyligne à la condition bien évidement de ne pas supprimer cette dernière. J'ai bon ? -
[Challenge] De fin d'année
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Jolie, Pour ta version 1, j'ai une version équivalente sauf que je me suis limité pour le jeu de ne pas écrire de fonction auxiliaire et à ne me servir que des fonctions natives en Autolisp. Pour ta version 2, je vais étudié cela plus dans le détail quant je serais en meilleur forme, notamment comment fonctionne la façon dont tu exprime l'infini dans ton code, je vais surement apprendre quelque chose. Pour ce qui est d'éviter de recalculer la valeur en entré je m'étais essayé par le passé à écrire une fonction de "mémoïsation" (pas sur que ce soit le bon terme) à titre expérimental, impossible de retrouver mes codes pour les adapter à ce challenge, de toute façon les opérations étant limité le coût aurait été supérieur au gain. La version codé sur le principe de la fonction TriangleRec donné précédemment avec les fonctions mathématiques native fournie en AutoLisp (atan sin / sqrt expt + -), contrairement aux tiennes je n'ai pas bordé les saisies, j'ai été au plus simple, l'idée était de montrer le procédé... ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Trigones 1 VDH-Bruno ;; ;; ---------------------------------------------------------------------------- ;; ;; Algorithme: Chaques fontions est définie en fonction d'une autre de façon ;; ;; qu'elles soient toutes chainées de façon à créer une dépendance ;; ;; circulaire, de fait si une valeur est insérer dans la boucle de ;; ;; dépendance toutes les fonctions sont alors définie et leurs ;; ;; valeurs respective retournées ;; ;; ---------------------------------------------------------------------------- ;; ;; Description: -> "lire dépend de" ;; ;; (tang) -> (sec) -> (cosinus) -> (cot) -> (csc) -> (sinus) -> (ang) -> (tang) ;; ;; ---------------------------------------------------------------------------- ;; ;; Liste des fonctions: ;; ;; - Angle (ang) ;; ;; - Sinus (sinus) ;; ;; - Cosinus (cosinus) ;; ;; - Sécante (sec) ;; ;; - Cosécante (csc) ;; ;; - Tangente (tang) ;; ;; - Cotangente (cot) ;; (defun trigones1 (ang sinus cosinus sec csc tang cot) (mapcar '(lambda (val fun) (if val (eval (list 'defun fun () val)) fun ) ) (list ang sinus cosinus sec csc tang cot) (list (defun ang () (atan (tang))) (defun sinus () (sin (ang))) (defun cosinus () (/ (cot) (sqrt (1+ (expt (cot) 2.))))) (defun sec () (/ 1. (cosinus))) (defun csc () (/ 1. (sinus))) (defun tang () (sqrt (1- (expt (sec) 2.)))) (defun cot () (sqrt (1- (expt (csc) 2.)))) ) ) (list (ang) (sinus) (cosinus) (sec) (csc) (tang) (cot)) ) -
[Challenge] De fin d'année
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Merci de la précision très intéressant, pour la version lisp je t’avouerai que je suis parti du principe que les valeurs saisies étant dans le premier quadrant du cercle, elle était forcément valide donc je n'ai pas prévu de gestion d'erreur... Le but "déguisé" était de montrer l’intérêt d'écrire une solution fonctionnelle en "chainant" les appels. Après comme il y avait peu de candidat sur le challenge j'ai aussi écrit une version plus "classique", version qui prend plus de 15mn à écrire 😉 . -
[Challenge] De fin d'année
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Bonsoir nazemrap, En Lisp c'est mieux mais si tu souhaites en déposer une que tu ne peux pas retranscrire dans ce langage, personnellement je ne suis pas contre. Par contre je ne pourrai pas te la tester ou te faire un éventuel retour dessus. Après tout dépend du langage car je sais que certains font appel à des bibliothèques mathématiques spécialisées très bien fournies, dans ce cas il y a plus vraiment de challenge;) Salutations Bruno -
[Challenge] De fin d'année
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Zut... Je viens d'en trouver une autre plus analytique, du coup la première que j'avais écrite perd un peu de son intérêt dans ce que je voulais démontrer, si j'avais un peu mieux réfléchie au sujet, j'aurais certainement modifier l'énoncé du challenge... Bon c'est le jeu on peut pas penser à tout😉 -
[Challenge] De fin d'année
VDH-Bruno a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Bonjour (gile) Génial, même si j'en doutais pas, oui merci d'attendre un peu pour ne pas tuer le match. Perso j'ai écrit la mienne en moins de 15mn (j'ai été au plus simple), et je pense que l'on doit avoir sensiblement la même, si tu es impatient, tu peux me la poster en MP je jetterai un œil ça m'occupera, j'ai exceptionnellement un peu de temps devant moi, je suis à l'isolement forcé depuis hier... donc un peu de temps pour lancer et tester un challenge. Bruno -
[Challenge] De fin d'année
(gile) a répondu à un(e) sujet de VDH-Bruno dans Pour aller plus loin en LISP
Salut, Je suis toujours ravi de pouvoir participer à un nouveau challenge. J'ai bien une réponse, mais je vais attendre un peu que d'autres répondent. -
Bonsoir, Une récente discussion m'a inspiré une petite proposition de challenge qui doit pouvoir parler à tous le monde https://cadxp.com/topic/54760-pb-de-trigo/?tab=comments#comment-312380 En général pour résoudre des problèmes de résolution dans un triangle, j'ai pour habitude de me servir des triangles semblables pour travailler sur un triangle dont l’hypoténuse (rayon du cercle unitaire) vaut 1, de façon à trouver la relation la plus simplifié à programmer pour résoudre le système. Pour mémoire dans cette configuration il suffit de connaitre une seule donné pour en déduire les autres. Dans cet esprit je vous propose d'élaborer une fonction trigones qui peut prendre en arguments: l'angle / sinus / cosinus / sécante / cosécante / tangente / cotangente, j'ai volontairement limité les arguments on pourrait en ajouter. (trigones ang sinus cosinus sécante cosécante tangente cotangente) Dans l'appel de la fonction, on ne renseignerait qu'un argument les autres valant nil, et la fonction retournerait tous les autres cotés, et ce quelque soit l'argument renseigné. Ex: Appel de fonction en renseignant l'angle: _$ (trigones (/ pi 4) nil nil nil nil nil nil) (0.785398 0.707107 0.707107 1.41421 1.41421 1.0 1.0) Ex: Appel de fonction en renseignant le sinus: _$ (trigones nil 0.6 nil nil nil nil nil) (0.643501 0.6 0.8 1.25 1.66667 0.75 1.33333) Ex: Appel de fonction en renseignant la tangente: _$ (trigones nil nil nil nil nil 2 nil) (1.10715 0.894427 0.447214 2.23607 1.11803 2 0.5) Une petite illustration pour ceux dont la résolution des trigones est un lointain souvenir, on se limite a résoudre le triangle de rayon 1 dans le premier quadrant du cercle c'est à dire avec un angle compris entre 0 et PI/2 Un petit prétexte pour réviser sa trigo en cette fin d'année, bon code à tous.
-
C'est chiant, mais c'est pour une quatrième...
Erased a répondu à un(e) sujet de DenisHen dans Pause café
Salut, merci à toi d'avoir partagé ce challenge car j'ai appris que zéro est un chiffre pair, on apprend tous les jours, d'où mon unique proposition de réponse. Merci à Gile pour ses explications. Au prochain challenge ! -
Challenge Lisp lance par John Uhden
lecrabe a répondu à un(e) sujet de lecrabe dans LISP et Visual LISP
Hello @VDH-Bruno Veux tu que je publie "en ton nom: VDH-Bruno" ta 2eme routine sur le challenge ? (defun test2 (str) (= 26 (length (member 90 (reverse (member 65 (vl-sort (vl-string->list (strcase str)) '<)))))) ) La Sante, Bye, lecrabe -
Hello Coucou j'esperais voir un Francais jouer ... https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/programming-challenge/td-p/10735297 La Sante, Bye, lecrabe
-
Donnez moi un triangle ! ou plusieurs ? mais est-ce le problème posé est juste ?
Curlygoth a répondu à un(e) sujet de Curlygoth dans Calculs et simulation
alors sache qu'au pire j'écris le code quand je peux j'avance pas assez vite... mais j'avance petit à petit, j’espère clôturer mon quickhull (au début adapter pour 4 pts mais je vise un peux plus pour le challenge) un extrait pour ta patience ? Je suis en train d'écrire le QuickHull (en fin de code) '''PARTIE FONCTION MATH Function Hypothenuse(DX, DY) Hypothenuse = Sqr(DX * DX + DY * DY) End Function Function PI() PI = 4 * Atn(1) End Function Function MATH_AX_B_2PTS(Pt1, PT2) 'Ax+B Dim c(0 To 1) As Double c(0) = (PT2(1) - Pt1(1)) / (PT2(0) - Pt1(0)) 'A c(1) = PT2(1) - c(0) * PT2(0) 'B MATH_AX_B_2PTS = c End Function Function MATH_DISTANCE_PT_DROITE(a, b, PT) NUMERATEUR = Abs(a * PT(0) - PT(1) + b) DENOM = Sqr((a ^ 2 + 1)) MATH_DISTANCE_PT_DROITE = NUMERATEUR / DENOM End Function Function MATH_AX_B_PERPENDICULAIRE(a, b, PT) Dim c(0 To 1) As Double c(0) = 1 / (-a) c(1) = PT(1) - a * PT(0) MATH_AX_B_PERPENDICULAIRE = c End Function Function MATH_PT_INTERSECTION_2_DROITE(A1, B1, A2, B2) Dim c(0 To 1) As Double X = (B2 - B1) / (A1 - A2) Y = A1 * X + B1 c(0) = X c(1) = Y MATH_PT_INTERSECTION_2_DROITE = c End Function Function MATH_ALTI_POINT_TRIANGLE(PA, PB, PC, Pm) Vab = VECTEUR(PA, PB) Vac = VECTEUR(PA, PC) VN = PROD_VECTEUR(Vab, Vac) MATH_ALTI_POINT_TRIANGLE = Z_VECTEUR_NORMAL_Pa(PA, Pm, VN) End Function Function VECTEUR(PA, PB) Dim V(0 To 2) As Double For i = 0 To 2 V(i) = PB(i) - PA(i) 'Vecteur ab Next i VECTEUR = V End Function Function PROD_VECTEUR(Vab, Vac) Dim V(0 To 2) As Double V(0) = Vab(1) * Vac(2) - Vab(2) * Vac(1) V(1) = Vab(2) * Vac(0) - Vab(0) * Vac(2) V(2) = Vab(0) * Vac(1) - Vab(1) * Vac(0) PROD_VECTEUR = V End Function Function Z_VECTEUR_NORMAL_Pa(PA, Pm, VN) T1 = PA(0) * VN(0) + PA(1) * VN(1) T2 = PA(2) * VN(2) T3 = Pm(0) * VN(0) T4 = Pm(1) * VN(1) Z_VECTEUR_NORMAL_Pa = (T1 + T2 - T3 - T4) / VN(2) 'z4 = (x1*xn + y1*yn + z1*zn – x4*xn – y4*yn) / zn End Function Function DotProduct(v1 As Variant, v2 As Variant) As Double 'Produit scalaire par (gile) DotProduct = v1(0) * v2(0) + v1(1) * v2(1) + v1(2) * v2(2) End Function Function POINT_ON_POLY(PolyLigne, Pt1) Dim NbrePoints As Integer Dim Pt1(0 To 2) As Double Dim PT2(0 To 2) As Double Dim Ray As AcadRay Dim Points As Variant PT2(0) = Pt1(0) + 1 PT2(1) = Pt1(1) PT2(2) = Pt1(2) Set Ray = ThisDrawing.ModelSpace.AddRay(Pt1, PT2) ' Calcul du nombre de points d'intersection Points = PolyLigne.IntersectWith(Ray, acExtendNone) NbrePoints = UBound(Points) / 3 ' Détermination en fonction de la parité If NbrePoints Mod 2 = 0 Then 'MsgBox "Le point n'est pas dans le contour" POINT_ON_POLY = True Else 'MsgBox "Le point est dans le contour" POINT_ON_POLY = True End If Ray.Delete End Function Function PT_AU_DESSUS_DROITE(a, b, PT) Y = PT(0) * a + b If Y >= PT(1) Then PT_AU_DESSUS_DROITE = False Else PT_AU_DESSUS_DROITE = True End If End Function Function AJ_POINT_PO(plineObj, Num_vertex, PT) Dim newVertex(0 To 1) As Double newVertex(0) = PT(0) newVertex(1) = PT(1) plineObj.AddVertex Nun_vertex, newVertex plineObj.Closed = True AJ_POINT_PO = Num_vertex End Function Function POINT_SOMMET_POLY(Poly, PT) Dim PT_PO(0 To 1) As Double POINT_SOMMET_POLY = False d_D = 0.0001 COORD = Poly.Coordinates For j = 0 To UBound(COORD) Step 2 D_X = PT_PO(j) - PT(0) D_Y = PT_PO(j + 1) - PT(1) If FONCT.Hypothenuse(D_X, D_Y) < d_D Then POINT_SOMMET_POLY = True Exit Function Else End If Next j End Function Function POINT_D_MAX(Poly, LIST_POINT, NB_POINT, AX_B_, AU_DESSUS) 'Sous la forme L_POINT(XYZ, X) X nombre de points,XYZ min = 1 D_MAX = 0 For POINT = 0 To NB_POINT P_T(0) = LIST_POINT(0, POINT) P_T(1) = LIST_POINT(1, POINT) If POINT_SOMMET_POLY(Poly, P_T) = False Then If AU_DESSUS = PT_AU_DESSUS_DROITE(AX_B_(0), AX_B_(1), P_T) Then If D = "" Then D_MAX = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) POINT_D_MAX = P_T(0) & ";" & P_T(1) Else D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B_(0), AX_B_(1), P_T) If D > D_MAX Then POINT_D_MAX = P_T(0) & ";" & P_T(1) Else End If End If Else End If Else End If Next POINT End Function Function RECH_DES_4_POINTS_LES_PLUS_PROCHES(Pp1, NOM_BLOC) Dim TABL(4, 3) As Variant Dim temp As Long Dim blockRefObj As AcadBlockReference X = 0 Y = 1 Z = 2 D = 3 temp = -1 For ent = 0 To ThisDrawing.ModelSpace.Count - 1 Set entity = ThisDrawing.ModelSpace.Item(ent) If entity.ObjectName = "AcDbBlockReference" Then Set blockRefObj = entity If blockRefObj.EffectiveName = NOM_BLOC Then '"PTTOPO" 'DIST = FONCT.Hypothenuse(blockRefObj.InsertionPoint(X) - Pp1(X), blockRefObj.InsertionPoint(Y) - Pp1(Y)) D_X = blockRefObj.InsertionPoint(X) - Pp1(X) D_Y = blockRefObj.InsertionPoint(Y) - Pp1(Y) DIST = FONCT.Hypothenuse(blockRefObj.InsertionPoint(X) - Pp1(X), blockRefObj.InsertionPoint(Y) - Pp1(Y)) temp = temp + 1 If temp <= 4 Then Else temp = 4 End If For i = X To Z TABL(temp, i) = blockRefObj.InsertionPoint(i) Next i TABL(temp, D) = DIST Call Tri_2D(TABL, 0, temp, 3) Else End If Else End If Next ent RECH_DES_4_POINTS_LES_PLUS_PROCHES = TABL End Function Function CALCUL_Z_DANS_TRIANGLE_Z(Pa2D, Pb2D, Pc2D) Pa2D(2) = 0 Pb2D(2) = 0 Pc2D(2) = 0 Vab = FONCT.VECTEUR(Pa2D, Pb2D) Vac = FONCT.VECTEUR(Pa2D, Pc2D) Vam = FONCT.VECTEUR(Pa2D, M) Vba_ = FONCT.VECTEUR(Pb2D, Pa2D) Vbc = FONCT.VECTEUR(Pb2D, Pc2D) Vbm = FONCT.VECTEUR(Pb2D, M) Vca = FONCT.VECTEUR(Pc2D, Pa2D) Vcm = FONCT.VECTEUR(Pc2D, M) PV1_1 = FONCT.PROD_VECTEUR(Vab, Vam) PV1_2 = FONCT.PROD_VECTEUR(Vam, Vac) PV2_1 = FONCT.PROD_VECTEUR(Vba_, Vbm) PV2_2 = FONCT.PROD_VECTEUR(Vbm, Vbc) PV3_1 = FONCT.PROD_VECTEUR(Vca, Vcm) PV3_2 = FONCT.PROD_VECTEUR(Vcm, Vcm) PROD_SCAL_1 = FONCT.DotProduct(PV1_1, PV1_2) PROD_SCAL_2 = FONCT.DotProduct(PV2_1, PV2_2) PROD_SCAL_3 = FONCT.DotProduct(PV3_1, PV3_2) If PROD_SCAL_1 >= 0 And PROD_SCAL_2 >= 0 And PROD_SCAL_2 >= 0 Then Z = FONCT.MATH_ALTI_POINT_TRIANGLE(Pt1, PT2, pt3, P) pr(0) = P(0) pr(1) = P(1) pr(2) = Z Else End If End Function '''''''''''''''''''''''''''''''' ''''TRI A BULLE PAS DE MOI !!!! '''''''''''''''''''''''''''''''''' Public Sub Tri_2D(ByRef Tableau As Variant, _ mini As Long, _ Maxi As Long, _ Optional Colonne As Long = 0) Dim i As Long, j As Long, Pivot As Variant, TableauTemp As Variant, ColTemp As Long On Error Resume Next i = mini: j = Maxi Pivot = Tableau((mini + Maxi) \ 2, Colonne) While i <= j While Tableau(i, Colonne) < Pivot And i < Maxi: i = i + 1: Wend While Pivot < Tableau(j, Colonne) And j > mini: j = j - 1: Wend If i <= j Then ReDim TableauTemp(LBound(Tableau, 2) To UBound(Tableau, 2)) For ColTemp = LBound(Tableau, 2) To UBound(Tableau, 2) TableauTemp(ColTemp) = Tableau(i, ColTemp) Tableau(i, ColTemp) = Tableau(j, ColTemp) Tableau(j, ColTemp) = TableauTemp(ColTemp) Next ColTemp Erase TableauTemp i = i + 1: j = j - 1 End If Wend If (mini < j) Then Call Tri_2D(Tableau, mini, j, Colonne) If (i < Maxi) Then Call Tri_2D(Tableau, i, Maxi, Colonne) End Sub '''''''''''''CODE EN COURS d'ECRITURE !!!!!! Function QUICKHULL(L_POINT, NB_POINT) 'Sous la forme L_POOINT(XYZ, X) X nombre de points,XYZ min = 1 L_bound = 0 U_BOUND = NB_POINT 'Recherche des points extremes gauche et point droit Dim AX_B() Dim PT_GAUCHE(0 To 1) As Double Dim PT_DROIT(0 To 1) As Double Dim POLYPOINT(0 To 3) As Double For i = L_bound To U_BOUND If i = 0 Then PT_GAUCHE(0) = L_POINT(0, i) PT_GAUCHE(1) = L_POINT(1, i) PT_DROIT(0) = L_POINT(0, i) PT_DROIT(1) = L_POINT(1, i) Else If L_POINT(0, i) < PT_GAUCHE(0) Then PT_GAUCHE(0) = L_POINT(0, i) PT_GAUCHE(1) = L_POINT(1, i) Else End If If L_POINT(0, i) > PT_DROIT(0) Then PT_DROIT(0) = L_POINT(0, i) PT_DROIT(1) = L_POINT(1, i) Else End If End If Next i POLYPOINT(0) = PT_DROIT(0) POLYPOINT(1) = PT_DROIT(1) POLYPOINT(2) = PT_GAUCHE(0) POLYPOINT(3) = PT_GAUCHE(1) Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(POLYPOINT) AX_B_0 = FONCT.MATH_AX_B_2PTS(PT_GAUCHE, PT_DROIT) ReDim Preserve AX_B(0) AX_B(0) = AX_B_0 Dim PT_TEMP(0 To 2) 'Point au dessus PT_DESSUS = True dr = 0 For i = L_bound To U_BOUND PT_TEMP(0) = L_POINT(0, i) PT_TEMP(1) = L_POINT(1, i) If POINT_SOMMET_POLY(plineObj, PT_TEMP) = False Then D = FONCT.MATH_DISTANCE_PT_DROITE(AX_B(dr)(0), AX_B(dr)(1), PT_TEMP) If PT_AU_DESSUS_DROITE(AX_B(0), AX_B(1), PT_TEMP) = PT_DESSUS Then Nb_vertex = AJ_POINT_PO(plineObj, 1, PT_TEMP) + 1 Else End If Else End If Next i End Function Merci de ne pas porter de jugement !!!! C'est V0.0 XD donc même pas fini XD Je vais ajouter un point a ma polyligne ensuite vérifier les points encore au dessus des 2 segments créés ! D'ailleurs peut etre gérer par rapport a la polyligne plutot qu'aux points d'ailleurs.... bon ben je vais modifier ça XD -
La notion de bulge est un moyen très efficient pour conserver l'information concernant la courbure d'un segment de polyligne avec un seul nombre (notamment dans le DXF), mais du coup, c'est moins pratique pour faire directement des calculs. D'un autre côté, les fonctions vlax-curve exposent à l'environnement Visual LISP (pas d'équivalent en VBA ou en AutoLISP sur MAC) une petite partie d'une API ObjectARX et .NET qui définit des objets purement géométriques (sans représentation graphique) utilisés pour les calculs géométriques, celle concernant les objets curvilignes. C'est aussi dans cet environnement que la notion de "paramètre" pour les objets curvilignes est définie (à ma connaissance, elle n'existe dans les données DXF des entités que pour les ellipses, CF un récent challenge). J'avais essayé, il y a quelques temps maintenant de démarrer un sujet sur les paramètres des objets curvilignes. En .NET la classe Curve2d (il y a un équivalent Curve3d) est la classe de base pour, entre autres, les classes CompositeCurve2d, CircularArc2d et LinearEntity2d, cette dernière étant la classe de base pour LineSegment2d. Dans cet environnement, une polyligne correspond à un CompositeCurve2d qui est une succession de LineSegment2d ou de CircularArc2d jointifs. Avec .NET on récupère directement l'objet géométrique correspondant à un segment de polyligne en arc via la méthode GetArcSegment2dAt(index) et on accède ainsi directement à toutes ses propriétés.
-
Beaucoup, Beaucoup de lispeur m'ont dit que le vba n’était pas efficient... par rapport au lisp ! Maintennant, que j'entends l'inverse je vais vous dire le fond de ma pensé : Personnellement pour des taches "simple" sans de boucle le VBA est peut être plus rapide... mais soyons honnête : quand vous faites des outils (genre quickhull que j'avoue n'ai pas commencé XD/ Le challenge à luna) ou autre programme plus lourd (genre tourné tous les blocs d'un certain angle) le lisp est plus rapide ! Note perso : sachez que je suis les conversation lisp car je les combine avec du VBA et c'est juste génialissime !
-
Coucou, C'était le but premier du challenge au final ^^" J'ai fait quelques tests dont voici les résultats : ;; BENCHMARK D'UNE LWPOLYLINE DE 10 SOMMETS Elapsed milliseconds / relative speed for 8192 iteration(s): (GET-PT-LIST-BRUNO NAME).....................1466 / 3.55 <fastest> (GET-PT-LIST-CURVE NAME).....................1560 / 3.34 (VLAX-CURVE-GETPOLYLINECOORDINATES N...).....1701 / 3.06 (VGETPOINT VNAME)............................1701 / 3.06 (GET-PT-LIST-RECURSIVE-MEMBER NAME)..........1747 / 2.98 (POLYPOINTS NAME)............................1763 / 2.96 (GET-PT-LIST-MEMBER NAME)....................1778 / 2.93 (GET-PT-LIST-NTH-RECURSIVE NAME).............1825 / 2.85 (GET-PT-LIST-RECURSIVE-COORDINATES V...).....1825 / 2.85 (GET-PT-LIST-REPEAT NAME)....................1919 / 2.71 (GET-PT-LIST-MAPCAR NAME)....................3183 / 1.64 (GET-PT-LIST-REMOVE NAME)....................3557 / 1.46 (GET-PT-LIST-SEARCH NAME)....................3572 / 1.46 (GET-PT-LIST-FOREACH NAME)...................3635 / 1.43 (GET-PT-LIST-BONUSCAD NAME)..................5101 / 1.02 (GET-PT-LIST-BRUNO VNAME)....................5210 / 1.00 <slowest> ;; BENCHMARK D'UNE LWPOLYLINE DE 100 SOMMETS Elapsed milliseconds / relative speed for 2048 iteration(s): (VGETPOINT VNAME)............................1107 / 5.19 <fastest> (GET-PT-LIST-BRUNO NAME).....................1217 / 4.72 (GET-PT-LIST-RECURSIVE-COORDINATES V...).....1232 / 4.66 (GET-PT-LIST-CURVE NAME).....................1389 / 4.13 (VLAX-CURVE-GETPOLYLINECOORDINATES N...).....1482 / 3.87 (GET-PT-LIST-MEMBER NAME)....................1498 / 3.83 (GET-PT-LIST-RECURSIVE-MEMBER NAME)..........1498 / 3.83 (POLYPOINTS NAME)............................1607 / 3.57 (GET-PT-LIST-NTH-RECURSIVE NAME).............1809 / 3.17 (GET-PT-LIST-REPEAT NAME)....................1825 / 3.15 (GET-PT-LIST-REMOVE NAME)....................2028 / 2.83 (GET-PT-LIST-MAPCAR NAME)....................2808 / 2.04 (GET-PT-LIST-FOREACH NAME)...................3790 / 1.51 (GET-PT-LIST-BRUNO VNAME)....................3868 / 1.48 (GET-PT-LIST-SEARCH NAME)....................4009 / 1.43 (GET-PT-LIST-BONUSCAD NAME)..................5741 / 1.00 <slowest> ;; BENCHMARK D'UNE LWPOLYLINE DE 1 000 SOMMETS Elapsed milliseconds / relative speed for 128 iteration(s): (GET-PT-LIST-RECURSIVE-COORDINATES V...)......1045 / 14.48 <fastest> (VGETPOINT VNAME).............................1061 / 14.26 (GET-PT-LIST-BRUNO NAME)......................1077 / 14.05 (VLAX-CURVE-GETPOLYLINECOORDINATES N...)......1248 / 12.13 (GET-PT-LIST-CURVE NAME)......................1295 / 11.68 (GET-PT-LIST-RECURSIVE-MEMBER NAME)...........1388 / 10.90 (GET-PT-LIST-MEMBER NAME).....................1435 / 10.54 (POLYPOINTS NAME).............................1513 / 10.00 (GET-PT-LIST-REMOVE NAME).....................1560 / 9.70 (GET-PT-LIST-REPEAT NAME).....................1654 / 9.15 (GET-PT-LIST-MAPCAR NAME).....................2684 / 5.64 (GET-PT-LIST-BRUNO VNAME).....................2730 / 5.54 (GET-PT-LIST-NTH-RECURSIVE NAME)..............3074 / 4.92 (GET-PT-LIST-FOREACH NAME)....................4290 / 3.53 (GET-PT-LIST-SEARCH NAME).....................4446 / 3.40 (GET-PT-LIST-BONUSCAD NAME)..................15132 / 1.00 <slowest> ;; BENCHMARK D'UNE LWPOLYLINE DE 10 000 SOMMETS Elapsed milliseconds / relative speed for 32 iteration(s): (VGETPOINT VNAME)..............................1372 / 230.03 <fastest> (GET-PT-LIST-RECURSIVE-COORDINATES V...).......1420 / 222.26 (GET-PT-LIST-BRUNO NAME).......................1591 / 198.37 (VLAX-CURVE-GETPOLYLINECOORDINATES N...).......1887 / 167.25 (GET-PT-LIST-CURVE NAME).......................1903 / 165.85 (POLYPOINTS NAME)..............................2138 / 147.62 (GET-PT-LIST-MEMBER NAME)......................2152 / 146.66 (GET-PT-LIST-RECURSIVE-MEMBER NAME)............2200 / 143.46 (GET-PT-LIST-REMOVE NAME)......................2464 / 128.09 (GET-PT-LIST-REPEAT NAME)......................2605 / 121.15 (GET-PT-LIST-MAPCAR NAME)......................3884 / 81.26 (GET-PT-LIST-FOREACH NAME).....................5429 / 58.13 (GET-PT-LIST-BRUNO VNAME)......................5679 / 55.57 (GET-PT-LIST-SEARCH NAME)......................5819 / 54.24 (GET-PT-LIST-NTH-RECURSIVE NAME)..............42682 / 7.39 (GET-PT-LIST-BONUSCAD NAME)..................315606 / 1.00 <slowest> Le plus étonnant c'est la différence d'efficacité entre l'utilisation de l'ename ou du VLA-Object sur les fonctions (vlax-curve-*) ! °o° Les durées pour la fonction proposée par BonusCAD me semble quelque peu exagéré mais bon... A savoir que les fonctions (vgetpoint) et (get-pt-list-recursive-coordinates) sont strictement les mêmes, pour le coup @Fraid on a pensé à la même chose ^^" La fonction (get-pt-list-recursive-member) correspond à la fonction (massoc) utilisant la fonction (member), à savoir que j'utilise personnellement la fonction (get-pt-list-member) qui correspond à la version itérative de (massoc) :3 Evidemment, les fonctions qui vérifie chaque paire DXF au lieu de "sauter" les paires inutiles semblent plus lentes (plus de passage dans la boucle ?). Les fonctions (vlax-curve-*) semblent plus rapides que la gestion de la liste DXF de l'entité et la propriété 'Coordinates semble également un peu plus rapide que les fonctions (vlax-curve-*), bien que se soit dommage que les coordonnées ne soient pas ranger 2 à 2 directement (cela éviterait la boucle et donc il existerait une fonction existante capable de renvoyer les coordonnées d'une polyligne directement). Voici les différentes versions que j'avais essayé au fil du temps (la fonction (get-pt-list-curve) est très récente, merci @Olivier Eckmann pour m'avoir appris la signification des paramètres pour les (vlax-curve-*) ! ♥) : (defun get-pt-list-curve (name / pt-list n) (repeat (fix (setq n (1+ (vlax-curve-getEndParam name)))) (setq pt-list (cons (vlax-curve-getPointAtParam name (setq n (1- n))) pt-list ) ) ) pt-list ) (defun get-pt-list-member (name / pt-list entlist) (setq entlist (entget name)) (while (setq entlist (member (assoc 10 entlist) entlist)) (setq pt-list (cons (cdar entlist) pt-list) entlist (cdr entlist) ) ) (reverse pt-list) ) (defun get-pt-list-recursive-member (name / f entlist) (defun f (entlist) (if (setq entlist (member (assoc 10 entlist) entlist)) (cons (cdar entlist) (f (cdr entlist))) ) ) (f (entget name)) ) (defun get-pt-list-search (name / pt-list entlist) (setq entlist (entget name)) (while entlist (if (= (caar entlist) 10) (setq pt-list (cons (cdar entlist) pt-list)) ) (setq entlist (cdr entlist)) ) (reverse pt-list) ) (defun get-pt-list-repeat (name / pt-list entlist) (repeat (cdr (assoc 90 (setq entlist (entget name)))) (setq entlist (member (assoc 10 entlist) entlist) pt-list (cons (cdar entlist) pt-list) entlist (cdr entlist) ) ) (reverse pt-list) ) (defun get-pt-list-remove (name / pt-list) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget name) ) ) ) (defun get-pt-list-mapcar (name / pt-list) (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (cdr x)) ) (entget name) ) ) ) (defun get-pt-list-nth-recursive (name / f) (defun f (lst i / x) (if (= (car (setq x (nth i lst))) 10) (cons (cdr x) (f lst (+ i 5))) ) ) (setq entlist (entget name)) (f entlist (vl-position (assoc 10 entlist) entlist)) ) (defun get-pt-list-recursive-coordinates (vname / f) (defun f (lst) (if lst (cons (list (car lst) (cadr lst)) (f (cddr lst))) ) ) (f (vlax-get vname 'coordinates)) ) Bisous, Luna
-
Pour essayer de revenir au challenge (et avant de digresser moi aussi) je dévoile différentes implémentations de la routine générique massoc (pour multiple assoc) qui permet de récupérer toutes les entrées d'un même groupe de code dans une liste DXF. Ma réponse en "pur AutoLISP" utiliserait l'implémentation que je préfère : (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) (defun polyPoints (pl) (massoc 10 (entget pl)) ) Pour récupérer les sommets de la polyligne en coordonnées SCG (fonctionne aussi avec le polylignes 2d et 3d) : (defun vlax-curve-getPolylineCoordinates (pl / i pts) (repeat (setq i (if (vlax-curve-isClosed pl) (fix (vlax-curve-getEndParam pl)) (1+ (fix (vlax-curve-getEndParam pl))) ) ) (setq pts (cons (vlax-curve-getPointAtParam pl (setq i (1- i))) pts)) ) )
-
Bonjour, Oui je connais ces messages, pour cette raison j'ai mauvaise conscience à proposer la moindre ligne de code sur ce challenge.
-
La fonction qui répond au challenge : private static Point2d[] GetPlinePoints(ObjectId id) { using (var tr = new OpenCloseTransaction()) { var pline = (Polyline)tr.GetObject(id, OpenMode.ForRead); var result = new Point2d[pline.NumberOfVertices]; for (int i = 0; i < result.Length; i++) { result[i] = pline.GetPoint2dAt(i); } return result; } } Une commande de test pour sélectionner la polyligne et choisir le nombre d'itération pour le 'benchmark'. [CommandMethod("TEST")] public static void Test() { var doc = AcAp.DocumentManager.MdiActiveDocument; var db = doc.Database; var ed = doc.Editor; var entOpts = new PromptEntityOptions("\nSélectionnez une polyligne: "); entOpts.SetRejectMessage("\nL'objet séléctionné n'est pas une polyligne."); entOpts.AddAllowedClass(typeof(Polyline), true); var entRes = ed.GetEntity(entOpts); if (entRes.Status != PromptStatus.OK) return; var id = entRes.ObjectId; var kwOpts = new PromptKeywordOptions("\nChoisissez le nombre d'itérations [64/512/4096/32768]: ", "64 512 4096 32768"); var kwRes = ed.GetKeywords(kwOpts); if (kwRes.Status != PromptStatus.OK) return; int nb = int.Parse(kwRes.StringResult); var sw = new System.Diagnostics.Stopwatch(); sw.Start(); for (int i = 0; i < nb; i++) { GetPlinePoints(id); } sw.Stop(); ed.WriteMessage($"\nElapsed milliseconds {sw.ElapsedMilliseconds} for {nb} iterations"); } Attaché, un ZIP à débloquer contenant la DLL à charger dans AutoCAD avec NETLOAD. GetPointListChallenge.zip
-
Vui en effet je pensais avoir clarifier ce point ^^" Donc dans l'idée il faut une fonction avec un seul argument correspondant à l'ename ou vla-object de la polyligne et le retour doit être sous forme de liste de point : ( (X1 Y1) (X2 Y2) ... (Xn-1 Yn-1) (Xn Yn) )avec n le nombre de sommets, l'indice 1 correspondant au point de départ de la polyligne, l'indice n correspondant au point d'arrivée de la polyligne. La sélection de la polyligne sera donc fait en amont par le biais d'une variable pour tester :3 En effet, le but de ce challenge c'est d'essayer de trouver plusieurs façons de faire en cherchant à approfondir les recherches au maximum. Chacun de nous à une manière de penser qui nous est propre (méthode itérative ou récursive par exemple), des fonctions de prédilection, etc. Donc ici le but étant de sortir des sentiers battus justement pour forcer les développeurs à se renseigner sur d'autres fonctions qu'ils n'ont pas l'habitude d'utiliser, de chercher les optimisations pour limiter les boucles, etc. Donc quoi de mieux pour cela que de prendre une fonction très simple qui permet un nombre d'alternatives très important ! Bien trop souvent on a nos habitudes de langage et on reste dans notre zone de confort, j'aimerais juste en sortir de cette zone pour apprendre différentes logiques, fonctions, réflexions, ... Après je me pose tout de même la question si en terme de retour on ne peut pas élargir un peu les possibilités comme des SafeArray (certains programmes, selon qu'ils soient en AutoLISP vanilla, en Visual LISP ou même VBA ne gèrent pas les listes de la même manières) donc il se peut que pour un programme en Visual, la conversion d'un SafeArray en liste pour ensuite convertir cette liste en SafeArray pour continuer un autre programme ne fasse pas grand sens... >w< Donc en résumé on va dire : (defun func_name (ObjName / ...) ... ) command: (setq name (car (entsel))) ; ou (vlax-ename->vla-object (car (entsel))) command: (func_name name) ((12.4 584.5) (123.8 1.7) (12.8 967.4)) ; ou #<safearray...> équivalent à (vlax-safearray->list #<safearray...>) = ((12.4 584.5) (123.8 1.7) (12.8 967.4)) Bisous, Luna
-
Coucou, Un exercice sans difficulté de programmation en tant que tel, mais le but étant de réfléchir "autrement". On a tous eu besoin à un moment donné eu besoin de récupérer la liste des sommets d'une polyligne et pour ce faire, on a chacun(e) sa méthode :3 Cependant je me suis bien souvent demandé, existe-t-il une solution plus rapide ? Pour simplifier le challenge, l'exercice se porte uniquement sur les LWPOLYLINE, car les SPLINE, LINE, POLYLINE, ARC, etc ne possède pas les mêmes approches de programmation selon les objets. On peut prendre n'importe quel langage (en revanche je ne sais pas s'il existe un moyen d'utiliser un BenchMark sur plusieurs type de langage différent...?) histoire de comparer également les simplicités d'écriture selon les langages. La liste retournée doit contenir l'ensemble des sommets de la polyligne, dans le sens de lecture de la polyligne (donc le sommet de départ au début, le dernier à la fin) et le but étant de trouver une version qui permet d'aller suffisamment vite en fonction du nombre de sommets. J'ai généré sur le fichier ci-joint 4 polylignes ayant respectivement 10, 100, 1 000 et 10 000 sommets qui serviront de base (pour que tout le monde est la même). Le nombre de lignes importe peu, la vitesse d'exécution servira de comparaison. Concernant le Benchmark, j'utilise le BenchMark de Michael Puckett mais si vous en avez un autre, dite le histoire de maximiser les points communs pour la comparaison. Pour le temps de réponse, disons que je posterais mes versions ce we mais il n'y a pas de limite de temps 😜 Bisous, Luna get-pt-list.dwg BenchMark (Michael Puckett).lsp
-
Bonjour, Pour répondre à une demande sur un forum j'ai été amené à créer ce code. La demande portait sur le raccordement aux extrémités seulement de plusieurs polylignes (composées essentiellement de segments droits) se touchant à leurs extrémités mais étant sur des calques différents, par un rayon identique. Ce raccord d'arc devait être composé en deux parties pour rejoindre le calque des polylignes concernées. Bien que certainement inutile pour beaucoup (mais sait on jamais!), comme j'ai trouvé ce challenge intéressant, j'ai essayé d'y répondre. L’intéressé a été satisfait... Voici le code (des bugs peuvent subsister car moyennement testé) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun ang_x (px p1 p2 / l_pt l_d p ang) (setq l_pt (mapcar '(lambda (x) (list (car x) (cadr x) (caddr x))) (list px p1 p2)) l_d (mapcar 'distance l_pt (append (cdr l_pt) (list (car l_pt)))) p (/ (apply '+ l_d) 2.0) ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0) ) ) (defun k_th (p1 p2 c / k) (setq k (/ c (distance p1 p2))) (mapcar '+ (mapcar '* (mapcar '- p2 p1) (list k k k)) p1) ) (defun c:Spec_Fillet ( / js n ent lo_pt l_pt pt l3 js1 js2 alpha l_tg p_o a1 a2 dxf_210) (cond ((not (zerop (getvar "FILLETRAD"))) (setq js (ssget '((0 . "LWPOLYLINE") (67 . 0)))) (cond (js (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) lo_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))) lo_pt (list (car lo_pt) (last lo_pt)) lo_pt (mapcar '(lambda (z) (trans z 0 1)) lo_pt) ) (if (null l_pt) (mapcar '(lambda (x) (setq l_pt (cons x l_pt))) lo_pt) (foreach el lo_pt (if (null (vl-remove-if-not '(lambda (x) (equal el x 1E-08)) l_pt)) (setq l_pt (cons el l_pt)) ) ) ) ) ) ) (cond (l_pt (while l_pt (setq pt (car l_pt) js (ssget "_C" (mapcar '- pt '(0.05 0.05 0.0)) (mapcar '+ pt '(0.05 0.05 0.0)) '((0 . "LWPOLYLINE") (67 . 0))) ) (cond ((and js (eq (sslength js) 2)) (setq l3 (list pt)) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) lo_pt (mapcar '(lambda (z) (trans z 0 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))) ) (cond ((and (> (length lo_pt) 2) (equal pt (car lo_pt) 1E-08)) (setq lo_pt (list (car lo_pt) (cadr lo_pt))) ) ((and (> (length lo_pt) 2) (equal pt (last lo_pt) 1E-08)) (setq lo_pt (list (last lo_pt) (nth (- (length lo_pt) 2) lo_pt))) ) ) (setq lo_pt (vl-remove-if-not '(lambda (x) (not (equal pt x 1E-08))) lo_pt) l3 (append l3 lo_pt) ) (set (read (strcat "js" (itoa (1+ n)))) (entget ent)) ) (setq alpha (ang_x (car l3) (cadr l3) (caddr l3)) ) (cond ((not (equal alpha pi 1E-06)) (setq l_tg (* (getvar "FILLETRAD") (/ 1.0 (/ (sin (* alpha 0.5)) (cos (* alpha 0.5))))) p_o (k_th (car l3) (mapcar '* (mapcar '+ (polar (car l3) (angle (car l3) (cadr l3)) l_tg) (polar (car l3) (angle (car l3) (caddr l3)) l_tg) ) '(0.5 0.5 0.5) ) (+ (getvar "FILLETRAD") (* (getvar "FILLETRAD") (1- (/ 1.0 (sin (* alpha 0.5)))))) ) a1 (angle p_o (car l3)) a2 (angle p_o (polar (car l3) (angle (car l3) (cadr l3)) l_tg)) dxf_210 (z_dir p_o (car l3)) ) (if (or (zerop a2) (and (eq (rem a1 (* 3.5 pi)) a1) (> a1 a2))) (setq a2 (+ a2 (* 2 pi))) ) (entmake (list (cons 0 "ARC") (cons 100 "AcDbEntity") (assoc 67 js2) (assoc 410 js2) (assoc 8 js2) (if (assoc 62 js2) (assoc 62 js2) (cons 62 256)) (if (assoc 6 js2) (assoc 6 js2) (cons 6 "BYLAYER")) (if (assoc 370 js2) (assoc 370 js2) '(370 . -1)) (cons 38 (+ (cdr (assoc 38 js2)) (getvar "ELEVATION"))) (cons 39 (getvar "THICKNESS")) (cons 100 "AcDbCircle") (cons 10 (trans p_o 1 dxf_210)) (cons 40 (getvar "FILLETRAD")) (cons 210 dxf_210) (cons 100 "AcDbArc") (cons 50 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2))) (cons 51 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1))) ) ) (setq a2 (angle p_o (polar (car l3) (angle (car l3) (caddr l3)) l_tg)) ) (if (or (zerop a2) (and (eq (rem a1 (* 3.5 pi)) a1) (> a1 a2))) (setq a2 (+ a2 (* 2 pi))) ) (entmake (list (cons 0 "ARC") (cons 100 "AcDbEntity") (assoc 67 js1) (assoc 410 js1) (assoc 8 js1) (if (assoc 62 js1) (assoc 62 js1) (cons 62 256)) (if (assoc 6 js1) (assoc 6 js1) (cons 6 "BYLAYER")) (if (assoc 370 js1) (assoc 370 js1) '(370 . -1)) (cons 38 (+ (cdr (assoc 38 js1)) (getvar "ELEVATION"))) (cons 39 (getvar "THICKNESS")) (cons 100 "AcDbCircle") (cons 10 (trans p_o 1 dxf_210)) (cons 40 (getvar "FILLETRAD")) (cons 210 dxf_210) (cons 100 "AcDbArc") (cons 50 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2))) (cons 51 (if (and (< a1 a2) (<= (- a2 a1) pi)) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a2) (+ (angle '(0 0 0) (getvar "UCSXDIR")) a1))) ) ) ) ) ) ) (setq l_pt (cdr l_pt)) ) ) ) ) (T (princ "\nFILLETRAD doit être différent de zéro")) ) (prin1) )
