Aller au contenu

bonuscad

Membres
  • Compteur de contenus

    5 029
  • Inscription

  • Dernière visite

  • Jours gagnés

    56

Tout ce qui a été posté par bonuscad

  1. Ben avec tout ça, je vais bien réussir à faire quelque chose. B) J'ai trouvé l'oubli dans mon code, j'ai fait la même erreur que Patrick_35: tester l'égalité de la partie entière avec le nombre pour obtenir les valeurs inclusives voulues. En tout cas très instructif tous ces montages différents d'une fonction en somme basique.
  2. Ça le fait aussi, maintenant j'ai le choix. En le voyant écrit, je me dis que j'aurais pus le trouver seul, mais franchement j'ai piétiné... Merci à vous deux.
  3. En effet cela répond à mon désir, je vais pouvoir faire mes requêtes d'encadrement intelligentes pour map en lisp. Merci beaucoup (gile), mais je pensais vraiment à plus basique pour faire cela...
  4. Bonjour, J'essaye d'écrire le plus simplement possible une fonction d'encadrement d'un nombre réel. Mon problème majeur est que je veux qu'elle fonctionne avec les nombres POSITIF et aussi NEGATIF! pour un nombre réel n je voudrais l'entier strictement supérieur suivant et l'entier inférieur ou égal précédent. exemples d'encadrement: 5 > 4.3 >= 4 2 > 1.0 >= 1 1 > 0.5 >= 0 1 > 0.0 >= 0 0 > -0.75 >= -1 0 > -1.0 >= -1 (celui-ci par exemple n'est pas retourné de manière exacte par ma routine) -1 > -1.25 >= -2 J'arrive pas à écrire quelque chose de correct pour les nombres négatifs (enfin pas simplement..., je dois être fatigué) Un petit coup de pouce? Pour que la lumière fuse ;) Voici par exemple où j'en suis, mais qui ne fonctionne pas si je fourni un entier sous forme de réel en négatif. ((lambda ( / ) (setq q_pr (getreal "\n Réel?: ")) (princ (strcat "\n" (rtos q_pr 2 3) " >= " (rtos (if (< q_pr 0.0) (- (float (1+ (abs (fix q_pr))))) (float (fix q_pr)) ) ) ) ) (princ (strcat "\n" (rtos q_pr 2 3) " < " (rtos (if (< q_pr 0.0) (- (float (abs (fix q_pr)))) (float (1+ (fix q_pr))) ) ) ) ) (prin1) ))
  5. bonuscad

    mesurer un angle

    Si tu n'as pas accès aux commandes récentes, tu peux utiliser ceci pour palier au manque... (defun c:q_ang ( / px p1 p2 msg l_pt l_d p ang a_base a_dir) (initget 9) (setq px (getpoint "\nPoint au sommet: ") p1 px p2 px msg '("p1" "\n1er point: " "p2" "\n2ème point: ")) (foreach n (list p1 p2) (while (equal px n) (initget 9) (setq n (getpoint px (cadr msg))) (if (equal px n) (princ "\nLe point est confondu au sommet!") ) ) (set (read (car msg)) n) (setq msg (cddr msg)) ) (setq l_pt (mapcar '(lambda (x) (list (car x) (cadr 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) a_base (getvar "ANGBASE") a_dir (getvar "ANGDIR") ) (if (zerop (* p (- p (cadr l_d)))) (setq ang pi) (setq ang (* (atan (sqrt (/ (* (- p (car l_d)) (- p (caddr l_d))) (* p (- p (cadr l_d)))))) 2.0)) ) (setvar "ANGBASE" 0) (setvar "ANGDIR" 0) (alert (strcat "Angle exprimé en fonction des unités actives" "\nAngle: <" (angtos ang (getvar "AUNITS") (getvar "AUPREC")) ">" "\nComplémentaire à " (angtos pi (getvar "AUNITS") 0) ": <" (angtos (- pi ang) (getvar "AUNITS") (getvar "AUPREC"))">" ) ) (print (angtos ang (getvar "AUNITS") (getvar "AUPREC"))) (setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir) (prin1) )
  6. Pardon pour ma boulette à propos de OR :wacko:, c'est bien XOR pour moi le filtre qui à l'air bon: (sssetfirst nil (ssget "X" '((0 . "*POLYLINE")(-4 . "<NOT")(-4 . "&")(70 . 120)(-4 . "NOT>")))) 120= 8 + 16 + 32 + 64
  7. Pas facile les filtre logique!... :P OR est exclusif (c'est soit l'un soit l'autre mais pas les deux) (0 . "POLYLINE") et (0 . "LWPOLYLINE") peuvent être regrouper (sans confusion) comme ceci (0 . "*POLYLINE") Ca te fera moins d'opérateur logique. Encore un petit effort, tu vas y arriver.
  8. Pour le faire plus rapidement. J'avais déjà donné un exemple de code pour faire des conversions à la volée. Je le redonne ici adapté à GoogleMap vers du Lambert93 (j'inverse la latitude/longitude de GoogleMap) ;Conversion de coordonnéees GoogleMap vers Lambert93 RGF (defun c:xy_LL84toRGF93 (/ as_cor ll lat lon pkpt desc) (setq as_cor (ade_projgetwscode)) (cond ((eq (strcase as_cor) "LL84") (ade_projsetsrc as_cor) (ade_projsetdest "Lambert93") (while (setq pkpt (getpoint "\nFaites un copié-collé des coordonnées GoogleMap: ")) (setq pkpt (list (cadr pkpt) (car pkpt) (caddr pkpt))) (setq ll (ade_projptforward pKpt) lat (car ll) lon (car (cdr ll)) desc (ade_projgetinfo "Lambert93" "description") ) (princ (strcat "\nLongitude,Lattitude: " (rtos (car pkpt) 2 6) "," (rtos (cadr pkpt) 2 6) "\n Converti depuis: " as_cor "\n Converti vers : " desc "\nX,Y: " (rtos lat 2 6) "," (rtos lon 2 6) ) ) ) ) (T (initget "Oui Non _Yes No") (if (eq (getkword "\nAssigner le système de coordonnées LL84 au dessin actuel[Oui/Non]? <N>: ") "Yes") (progn (ade_projsetwscode "LL84") (princ "\nSystème attribué, relancez la commande") ) ) ) ) (prin1) )
  9. Il me semble que dans excel l'apostrophe oblige celui-ci à considérer du numérique sous forme de texte. Il empêche donc l'évaluation des nombres.
  10. J'ai regardé et cela vient de la fonction (vlax-curve-getPointAtDist) qui avec une spline (et seulement ce type d'objet!...) arrive à retourner un point même si l'argument distance est complètement loufoque (distance négative par exemple) J'ai donc introduit des contrôles supplémentaires pour palier à cet inconvénient, ça à l'air de fonctionner mais en contre partie la routine n'a plus le même comportement qu'avant avec des cercles et ellipses complètes: on ne peut plus dépasser l'origine trigo comme avant. PS: Les codes proposés ont été corrigés. Je pense avoir maintenant répondu à ton souhait. Les Splines sont des entités complexes que je n'aime pas manipuler en programmation car j'avais déjà constaté des retours très surprenant avec les fonctions (vlax-curve-xxxxxxx) qui m'échappe complétement.
  11. Ta demande me semble incohérente, pourquoi? D'abords tu me demande les 2 points, j'ai du mal à comprendre pourquoi! En plus dans certain cas, seul un point est possible (suivant la position du point de référence) Et puis si ceux-ci ne sont pas dessinés, il ne m’aie pas possible de stocker 2 points dans la variable LASTPOINT; donc quid du résultat ?... Néanmoins voici ton souhait: (defun draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:measure_on_curve ( / js ent vla_obj param_end perim_obj op pt_ref dist_ref len_vtx new_pt key) (vl-load-com) (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une mesure.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (setq ent (ssname js 0) vla_obj (vlax-ename->vla-object ent) param_end (vlax-curve-getEndParam vla_obj) perim_obj (vlax-curve-getDistAtParam vla_obj param_end) op '+ ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nPoint de référence de la mesure: ") pt_ref (vlax-curve-getClosestPointTo vla_obj (trans pt_ref 1 0)) ) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint vla_obj pt_ref)) (initget 7) (setq len_vtx (getdist (trans pt_ref 0 1) "\nLongueur du segment: ")) (cond ((<= len_vtx perim_obj) (if (or (null (setq new_pt (vlax-curve-getPointAtDist vla_obj (+ dist_ref len_vtx)))) (> ((eval op) dist_ref len_vtx) perim_obj)) (setq new_pt (vlax-curve-getPointAtDist vla_obj (- dist_ref len_vtx))) ) (draw_pt (trans new_pt 0 1) 3) (princ "\n<Click+gauche> pour additionner ou soustraire; <Entrée>/[Espace]/Click+droit pour finir!.") (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25)) (cond ((eq (car key) 3) (if (eq op '+) (setq op '-) (setq op '+)) (if (and (<= ((eval op) dist_ref len_vtx) perim_obj) (>= ((eval op) dist_ref len_vtx) 0.0)) (setq new_pt (vlax-curve-getPointAtDist vla_obj ((eval op) dist_ref len_vtx))) (setq new_pt nil) ) ) ) (if new_pt (progn (redraw) (draw_pt (trans pt_ref 0 1) 1) (draw_pt (trans new_pt 0 1) 3)) (progn (redraw) (draw_pt (trans pt_ref 0 1) 1)) ) ) (if new_pt (progn (initget "Oui Non _Yes No") (if (not (setq key (getkword "\nGénerer le/les points [Oui/Non]? <O>: "))) (setq key "Yes")) (cond ((eq key "Yes") (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons 8 (getvar "CLAYER")) '(100 . "AcDbPoint") (cons 10 new_pt) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons 8 (getvar "CLAYER")) '(100 . "AcDbPoint") (cons 10 pt_ref) '(210 0.0 0.0 1.0) ) ) ) ) ) ) (redraw) ) (T (princ "\nLa longueur introduite est plus grande que l'objet.") ) ) (redraw ent 4) (prin1) ) NB: J'ai simplifié la 1ère version proposée. J'ai supprimé l'option Complémentaire qui n'était pas vraiment utile et donnait une confusion d'utilisation. Le click-gauche est devenue la bascule pour ajouter/retrancher la longueur spécifiée (si cela est possible, bien sur!)
  12. Pas assez testé :angry: Merci du retour, c'est une erreur d'inclusion sur le code 70 (pour exclure les mailles dans les polylignes) qui était la cause du problème. J'ai modifié le code (la constitution du filtre) ci-dessus.
  13. Bonjour, J'avais besoin de réaliser des mesures de longueur sur des objets curvilignes(POLYLINE,LIGNE,ARC,CERCLE,ELLIPSE,SPLINE). Jusqu'à maintenant c'était parfois laborieux (surtout sur des objets courbes) pour obtenir une longueur précise à partir d'un point de référence quelconque sur l'objet. J'ai donc créé ce petit lisp pour palier à cet inconvénient, il pourra peut être vous rendre service... Le point retourné sur la courbe résultante à partir de la longueur donnée depuis le point de référence sera stocké dans la variable LASTPOINT. Ainsi, par exemple, pour tracer une ligne partant de ce point précis, il suffira d'entrer le symbole "@" au message "du point: " pour faire partir la ligne de ce point calculé. Si mon discours ne vous semble pas clair, le mieux est de tester ;) (defun draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:measure_on_curve ( / js ent vla_obj param_end perim_obj op pt_ref dist_ref len_vtx new_pt key) (vl-load-com) (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une mesure.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (setq ent (ssname js 0) vla_obj (vlax-ename->vla-object ent) param_end (vlax-curve-getEndParam vla_obj) perim_obj (vlax-curve-getDistAtParam vla_obj param_end) op '+ ) (redraw ent 3) (initget 1) (setq pt_ref (getpoint "\nPoint de référence de la mesure: ") pt_ref (vlax-curve-getClosestPointTo vla_obj (trans pt_ref 1 0)) ) (draw_pt (trans pt_ref 0 1) 1) (setq dist_ref (vlax-curve-getDistAtPoint vla_obj pt_ref)) (initget 7) (setq len_vtx (getdist (trans pt_ref 0 1) "\nLongueur du segment: ")) (cond ((<= len_vtx perim_obj) (if (or (null (setq new_pt (vlax-curve-getPointAtDist vla_obj (+ dist_ref len_vtx)))) (> ((eval op) dist_ref len_vtx) perim_obj)) (setq new_pt (vlax-curve-getPointAtDist vla_obj (- dist_ref len_vtx))) ) (draw_pt (trans new_pt 0 1) 3) (princ "\n<Click+gauche> pour additionner ou soustraire; <Entrée>/[Espace]/Click+droit pour finir!.") (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25)) (cond ((eq (car key) 3) (if (eq op '+) (setq op '-) (setq op '+)) (if (and (<= ((eval op) dist_ref len_vtx) perim_obj) (>= ((eval op) dist_ref len_vtx) 0.0)) (setq new_pt (vlax-curve-getPointAtDist vla_obj ((eval op) dist_ref len_vtx))) (setq new_pt nil) ) ) ) (if new_pt (progn (redraw) (draw_pt (trans pt_ref 0 1) 1) (draw_pt (trans new_pt 0 1) 3)) (progn (redraw) (draw_pt (trans pt_ref 0 1) 1)) ) ) (redraw) (if new_pt (setvar "LASTPOINT" (trans new_pt 0 1))) ) (T (princ "\nLa longueur introduite est plus grande que l'objet.") ) ) (redraw ent 4) (prin1) )
  14. Peut être ceci, en repartant de la structure du code ci-dessus. (defun C:Mask_PerCent ( / js ref_spl n ent dxf_ent lst nb cnt dxf_70 d_x d_z slop) (setq js (ssget '((0 . "3DFACE")))) (cond (js (initget 5) (setq ref_slp (getreal "\nPente (en %) de référence pour masquer les arrêtes des 3DFACEs: ")) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent) lst (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) (last lst) 1E-13) (setq lst (list (car lst) (cadr lst) (caddr lst)) nb 3.0) (setq nb 4.0) ) (setq lst (append lst (list (car lst))) cnt 1 dxf_70 '(0)) (repeat (fix nb) (setq d_x (distance (list (caar lst) (cadar lst)) (list (caadr lst) (cadadr lst))) d_z (abs (- (caddar lst) (caddr (cadr lst)))) slop (* (/ d_z d_x) 100.0) ) (if (>= slop ref_slp) (setq dxf_70 (cons cnt dxf_70)) ) (setq cnt (* cnt 2)) ) (entmod (subst (cons 70 (apply '+ dxf_70)) (assoc 70 dxf_ent) dxf_ent)) ) ) ) (prin1) )
  15. C'est vrai que cela peut être fastidieux de faire ça manuellement, du coup j'ai penser à faire un truc comme ça. Après le résultat, il suffit de griper le sommet central et de l’emmener où on veut. (defun C:subdivise3dface ( / ent dxf_ent typ_ent lst nb pt_div js) (while (/= typ_ent "3DFACE") (setq ent (entsel "\nChoix de la 3Dfaces à subdiviser: ") typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))) ) ) (setq lst (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) (last lst) 1E-13) (setq lst (list (car lst) (cadr lst) (caddr lst)) nb 3.0) (setq nb 4.0) ) (setq pt_div (list (/ (apply '+ (mapcar 'car lst)) nb) (/ (apply '+ (mapcar 'cadr lst)) nb) (/ (apply '+ (mapcar 'caddr lst)) nb) ) lst (append lst (list (car lst))) ) (entdel (car ent)) (setq js (ssadd)) (repeat (fix nb) (entmake (list '(0 . "3DFACE") '(100 . "AcDbEntity") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent) '(100 . "AcDbFace") (cons 10 (car lst)) (cons 11 (cadr lst)) (cons 12 pt_div) (cons 13 pt_div) '(70 . 0) ) ) (setq js (ssadd (entlast) js) lst (cdr lst) ) ) (sssetfirst nil js) (prin1) )
  16. bonuscad

    Rappel de coordonnée

    A une demande sur un forum US, j'avais modifié ma routine pour la simplifier au niveau du format. Voici ce qui en avait résulté. Dim-Grid_en.lsp
  17. bonuscad

    Code ASCII

    Ce n'est pas une combinaison de touche comme pour le codes ASCII. Tu tapes simplement dans le texte ce que j'ai mis en gras (Attention les majuscules sont importantes) Une fois le dernier caractère frappé, si le code est reconnu, il t'affiche le caractère spécial correspondant. Pour avoir les codes faire une recherche sur google avec UNICODE. (C'est touffu, on s'y perd un peu) Tu peux regarder aussi ce fichier incomplet car ancien
  18. Bonjour, Quand cela m'arrive (car cela m’est déjà arrivé), je fais ceci en ligne de commande: (entget (handent "1F")) ici "1F" est le nombre hexadécimal retourné par le message d'avertissement. Cela me permet d'identifier déjà quel objet me pose problème. Après je le supprime pour le recréer à l'identique, et par précaution je fais ensuite la commande "_AUDIT" pour vérifier l'intégrité du dessin.
  19. bonuscad

    Code ASCII

    As tu essayé la notation Unicode? pour le diamètre \U+00D8 pour le cube \U+00B3 Cela fonctionne bien généralement avec les polices TTF, moins bien avec les polices SHX (qui préfère la notation ANSI)
  20. En faisant de l'assemblage de routines existantes, j'ai rapidement monté ceci. Je l'ai testé que très brièvement... Cela pourra traiter des LWPOLYLINE,POLYLINE(2D),LINE,CIRCLE et ARC d'un jeu de sélection. (defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new) (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls))))) (while (cadr ls) (if (zerop (car lb)) (setq l_new (append l_new (list (car ls)))) (progn (setq rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0) a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb)))))) ) (if (< a 0.0) (setq a (- (* 2.0 pi) a))) (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0)) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb))))))) ) ) ) (setq ls (cdr ls) lb (cdr lb)) ) (append l_new (list (car ls))) ) (defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst) (setq inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin)) ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end))) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) ) (repeat nm (setq p1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) lst (append lst (list p1)) ) ) (setq p2 (polar pt_cen ang rad) lst (append lst (list p2)) ) (if (< sens 0.0) (reverse lst) lst) ) (defun c:po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bulg e_next dxf_next oldlayer oldosm key_mod scale_ml) (princ "\nChoix des polylignes à transformer en multilignes: ") (setq jspl (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 124) (-4 . "NOT>"))) nbr 0 ) (cond (jspl (initget "Dessus Nulle dEssous _Top Zero Bottom") (setq key_mod (getkword (strcat "\nEntrez le type de justification [Dessus/Nulle/dEssous] <" (cond ((eq (getvar "cmljust") 0) "Dessus" ) ((eq (getvar "cmljust") 1) "Nulle" ) ((eq (getvar "cmljust") 2) "dEssous" ) ) ">: " ) ) ) (if key_mod (cond ((eq key_mod "Top") (setvar "cmljust" 0)) ((eq key_mod "Zero") (setvar "cmljust" 1)) ((eq key_mod "Bottom") (setvar "cmljust" 2)) ) ) (setq scale_ml (getdist (strcat "\nEntrez l'échelle de la multiligne <" (rtos (getvar "cmlscale")) ">: "))) (if scale_ml (setvar "cmlscale" scale_ml)) (setq oldlayer (getvar "clayer") oldosm (getvar "osmode")) (setvar "osmode" 0) (setvar "cmdecho" 0) (command "_.ucs" "_world") (repeat (sslength jspl) (setq typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr)))))) name_layer (cdr (assoc 8 dxf_ent)) ) (cond ((eq typent "LWPOLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent)) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "POLYLINE") (setq closed (boole 1 (cdr (assoc 70 dxf_ent)) 1) e_next (entnext ent) ) (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next))))) (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next)))) (setq lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst) l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg) ) ) (setq e_next (entnext e_next)) ) (setq lst (reverse lst) l_bulg (reverse l_bulg) lst (def_bulg_pl lst l_bulg closed) ) ) ((eq typent "LINE") (setq lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1)) closed 0 ) ) ((eq typent "CIRCLE") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) ent 1) (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) 0.0 (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) lst (append lst (list (car lst))) closed 1 ) ) ((eq typent "ARC") (setq lst (bulge_pts (trans (cdr (assoc 10 dxf_ent)) ent 1) (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent))) (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent))) (cdr (assoc 40 dxf_ent)) 1 ) closed 0 ) ) ) (cond (lst (setvar "clayer" name_layer) (command "_.mline") (foreach n lst (command n)) (if (not (zerop closed)) (command "_close") (command "")) (entdel ent) ) ) (setq nbr (1+ nbr) lst nil l_bulg nil) ) (command "_.ucs" "_previous") (setvar "clayer" oldlayer) (setvar "osmode" oldosm) (setvar "cmdecho" 1) ) (T (princ "\nSélection vide")) ) (prin1) )
  21. bonuscad

    Profil en long

    Relis ma réponse en n°7... choisir_coupe va re-coter à chaque fois le profil à l'échelle voulue (prendra en considération les éventuelle polyligne de couleur rajoutées entre temps...) Alors le problème est ta lecture en diagonale des réponses!... ;)
  22. bonuscad

    Profil en long

    Ok, mais j'ai bien dis qu'il fallait une LIGNE en 2D et pas une polyligne... Si tu as besoin de faire une coupe sinueuse, l'outil suggéré ne te conviendra pas, il faudra te tourner vers un applicatif dédié. Tu as la commande LISTE où la fenêtre de propriété (si l'objet est mis en surbrillance de sélection) pour te renseigner. Je crois que ça va être dur de concevoir un profil en long si de tel bases te manques...
  23. Comme le dit zebulon les multilignes ne peuvent être constituées que de segments droit. Après il est possible de simuler un arc en multiligne par succession de points assez rapprochés. Voici par exemple ce qui pourrait être fait pour dessiner un arc de multiligne par 3 points, mais je n'ai pas le temps pour intégrer ce concept dans le code proposé précédemment. ((lambda ( / p1 p2 ll pt_m px1 px2 key p3 px3 px4 pt_cen rad inc ang nm lst_pt pa1 pa2) (initget 9) (setq p1 (getpoint "\nPremier point: ")) (initget 9) (setq p2 (getpoint p1 "\nPoint suivant: ")) (setq ll (list p1 p2) pt_m (mapcar '/ (list (apply '+ (mapcar 'car ll)) (apply '+ (mapcar 'cadr ll)) (apply '+ (mapcar 'caddr ll)) ) '(2.0 2.0 2.0) ) px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2)) px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2)) ) (princ "\nDernier point: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (setq p3 (cadr key) ll (list p1 p3) pt_m (mapcar '/ (list (apply '+ (mapcar 'car ll)) (apply '+ (mapcar 'cadr ll)) (apply '+ (mapcar 'caddr ll)) ) '(2.0 2.0 2.0) ) px3 (polar pt_m (+ (angle p1 p3) (* pi 0.5)) (distance p1 p3)) px4 (polar pt_m (- (angle p1 p3) (* pi 0.5)) (distance p1 p3)) pt_cen (inters px1 px2 px3 px4 nil) ) (cond (pt_cen (setq rad (distance pt_cen p3) inc (angle pt_cen p1) ang (+ (* 2.0 pi) (angle pt_cen p3)) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) lst_pt '() ) (repeat nm (setq pa1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) pa2 (polar pt_cen inc rad) lst_pt (append lst_pt (list pa1 pa2)) ) ) (setq lst_pt (append lst_pt (list (if pa2 pa2 p1) p3))) (grvecs lst_pt) ) ) ) ) ) (cond (lst_pt (command "_.mline") (foreach n lst_pt (command "_none" n)) (command "") ) ) (prin1) ))
  24. Un lisp de 6ans déjà ... étonnant qu'il n'y ait pas eu d'autres propositions depuis plus au goût du jour. En tout cas, pour éviter le problème de smiley vous pouvez le prendre directement là: http://bonuscad.perso.sfr.fr/bonuscad/po2ml.lsp
  25. bonuscad

    Profil en long

    Une démarche pour essayer: Une fois rendu sur la page coupe_tn.lsp. Dans ton navigateur, tu fais "Fichier" -> "Enregistrer sous..." (Avec Firefox, avec IE il te propose directement soit de l'ouvrir, soit de l'enregistrer) Après avec l'explorateur tu fais un glisser-déposer de ce fichier enregistré dans la fenêtre graphique d'Autocad (c'est une façon parmi d'autre de charger un lisp) Avant de lancer la nouvelle commande, tu t'assures de bien avoir des 3Dface, si c'est un maillage polyface, le décomposer pour obtenir des 3dface. Tu dessines une ligne en 2D (éviter de s'accrocher au 3Dfaces; Z à zéro) sur ton maillage à l'endroit où tu veux faire ta coupe. A partir de ce moment, tu peux utiliser la commande coupe_tn en désignant la ligne 2d que tu as dessiné. Fais déjà un essai comme ceci pour découvrir ce que cela peut faire.
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité