-
Compteur de contenus
5 029 -
Inscription
-
Dernière visite
-
Jours gagnés
56
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par bonuscad
-
Plusieurs solutions possibles... Après la personnalisation du fichier AutoCAD.PGP suggéré. Tu peux aussi modifié le menu AutoCAD.MNS (garder le AutoCAD.MNU intact au cas où) et rajouter dans la partie ***ACCELERATORS ce qui suit: [CONTROL+"NUMPAD0"]^C^C_.-view;_bottom; [CONTROL+"NUMPAD1"]^C^C _.-view;_swiso; [CONTROL+"NUMPAD2"]^C^C_.-view;_front; [CONTROL+"NUMPAD3"]^C^C_.-view;_seiso; [CONTROL+"NUMPAD4"]^C^C_.-view;_left; [CONTROL+"NUMPAD5"]^C^C_.-view;_top; [CONTROL+"NUMPAD6"]^C^C_.-view;_right; [CONTROL+"NUMPAD7"]^C^C_.-view;_nwiso; [CONTROL+"NUMPAD8"]^C^C_.-view;_back; [CONTROL+"NUMPAD9"]^C^C_.-view;_neiso; Autre solution par le lisp par exemple: (defun c:view_choice ( / key) (setvar "cmdecho" 0) (princ "\n<0/1/2/3/4/5/6/7/8/9> pour choix; /[Espace] pour finir!.") (while (not (member (setq key (grread nil 2 1)) '((2 13) (2 32)))) (cond ((eq (cadr key) 48) (command "_.-view" "_bottom") (princ "\nSélectionne la vue -> De-Dessous.") ) ((eq (cadr key) 49) (command "_.-view" "_swiso") (princ "\nSélectionne la vue -> Sud-Ouest.") ) ((eq (cadr key) 50) (command "_.-view" "_front") (princ "\nSélectionne la vue -> Sud.") ) ((eq (cadr key) 51) (command "_.-view" "_seiso") (princ "\nSélectionne la vue -> Sud-Est.") ) ((eq (cadr key) 52) (command "_.-view" "_left") (princ "\nSélectionne la vue -> Ouest.") ) ((eq (cadr key) 53) (command "_.-view" "_top") (princ "\nSélectionne la vue -> De-Dessus.") ) ((eq (cadr key) 54) (command "_.-view" "_right") (princ "\nSélectionne la vue -> Est.") ) ((eq (cadr key) 55) (command "_.-view" "_nwiso") (princ "\nSélectionne la vue -> Nord-Ouest.") ) ((eq (cadr key) 56) (command "_.-view" "_back") (princ "\nSélectionne la vue -> Nord.") ) ((eq (cadr key) 57) (command "_.-view" "_neiso") (princ "\nSélectionne la vue -> Nord-Est.") ) ) ) (setvar "cmdecho" 1) (princ) )
-
Merci :red: Une petite explication sur l'usage de ma routine que j'ai omis, sous peine d'avoir des résultats erronés. La précision fournie doit être l'inverse de celle ci (pourquoi faire compliqué quand on peut faire simple) par exemple pour avoir un arrondi à 0.000005 près, faire (rtos (round_number -123456789.1257777 (/ 1 0.000005)) 2 12)
-
Salut Gilles, Il y a quand même un problème avec (defun round (num) (fix (+ num 0.5)) ) avec les nombres négatifs, (round -2.3) -> -1 ??? J'en profites pour donner ma version :exclam: (defun round_number (xr n / ) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n)) ) (round_number -2.3 0.5) -> -2 :D Après un test,ta fonction (round-prec) présente le même problème :( [Edité le 29/12/2006 par bonuscad]
-
Si vous êtes intéressé par des types de lignes personnalisés avec des formes SHX, je met un fichier ZIP disponible ICI Il contient tous les fichiers nécessaires :LIN, SHP (source des shx compilés), SHX ainsi qu'un fichier exemple (format 2000) de ces types de ligne au nombres de 5 motifs différents. A l'origine je les ai créé pour un usage cartographique, mais rien ne s'oppose à une autre utilisation. Ce sera mon cadeau de Noël, donc bonnes fêtes à tous les membres :present:
-
Et j'y vais de mon bout de code aussi :P (setq x_order (mapcar 'min (mapcar 'car lst))) (foreach n x_order (setq lst_result (cons (assoc n lst) lst_result)) )
-
Numéro de série matériel encore
bonuscad a répondu à un(e) sujet de marionsname dans Pour aller plus loin en LISP
Ben dit donc!.... Mais il ne me donne pas mon âge, c'est normal??? :P Pour info, tes 2 dernières propositions fonctionnent même sur une 2000, au contraire des précédentes. Je ne sais pas si je m'en servirais, mais en tout cas bravo pour tes recherches avec l'activeX. C'est quand même puissant cette bestiole, même si c'est pas toujours compatible entre toutes les versions 200x. -
ligne en pointillés ronds de + de 2. 11
bonuscad a répondu à un(e) sujet de miamy dans AutoCAD LT 2004
Ha! Je suis un peux surpris, mais je veux bien te croire. Si tu me laisse ton courriel en privé, je te ferais parvenir les fichiers correspondants. Donc sous LT, impossible de créer des formes pour utiliser avec la commande "FORMES" ("_SHAPE") ? -
Pour les amoureux d\'intrigues mathématiques
bonuscad a répondu à un(e) sujet de bonuscad dans Pause café
Désolé d'avoir fait un doublon, depuis un an, je peux être pardonnable. :red: Nous dirons que cela rafraichi le post de Kallain :calim: -
ligne en pointillés ronds de + de 2. 11
bonuscad a répondu à un(e) sujet de miamy dans AutoCAD LT 2004
Oui, tapes directement en ligne de commande "COMPILER" ("_COMPILE"), et une boite de sélection de fichier SHP te permettra d'indiquer le fichier à complier. Même sous LT, je pense que tout est disponible, il n'y a besoin d'aucun logiciel tierce :exclam: NB: bien placer le fichier SHX compilé dans un dossier de recherche d'AutoCad, ou en déclarer un nouveau. Idem pour le fichier LIN. -
Vous retrouverez sur ce SITE (très bien fait d'ailleurs) les différentes énigmes mathématiques qui ont pus être proposées sur CadXp, mais aussi plein de choses intéressantes. J'ai trouvé ça grâce à Didier qui a parlé du terme "Corauste" et je voulais en savoir plus!
-
Fonction arccosinus
bonuscad a répondu à un(e) sujet de interpmanu dans Pour aller plus loin en LISP
Evgeniy à raison utilise ATAN, sachant que: (defun tang (x / ) (/ (sin x) (cos x))) pour obtenir la tangente d'un angle à partir du sinus et cosinus. -
Bon, je ne vais pas faire le rabat-joie avec un nouveau venu, (en espérant un effort certain pour la prochaine fois) Ce que j'ai remarquer vite fait sans essayer ton code (setq d (distance P1 P1)) ???? ne serait pas (setq d (distance P1 P2)) (setq k (ssget)) (command "_ARRAY" k "" "_R" 1 (- N 1) d 1) (command "_ARRAY" (entlast) "" "_R" 1 (- N 1) d 1) serait plus simple et éviterais de faire une sélection. (command "_PLINE" P2 "@x,0" "") Ici tu as mis une variable en chaine de texte, ELLE NE SERA PAS EVALUEE faire plutôt (command "_PLINE" P2 (strcat "@" (rtos x) ",0") "") idem pour la suite
-
Bien que je ne sois pas un as dans la matière, je me rangerais sur la position de Mister Lecrabe. Je pense que que le mode de fonctionnement est plus proche de ce genre de truc , la clé n'est pas stocké dans l'courriel ... mais elle est indispensable pour décrypter celui-ci et le rendre lisible. Mais ce n'est que mon avis... :P
-
gestion de conflit objets/textes
bonuscad a répondu à un(e) sujet de fabcad dans Suggestions de développements
Je connais pas encore MAP ... Mais voici un extrait d'une routine que je me suis faite pour l'insertion d'un bloc avec des attributs Cela me permet de fixer mon point d'insertion en choississant entre les 4 quadrants et de placer correctement ma ligne de repère dans la zone qui me convient le mieux. Bien sur ici, cela n'insère rien, ca dessine seulement l'encombrement virtuel de mon bloc, mais si cela t'interresse.... ((lambda ( / ) (while (null (setq ent (entsel "\nChoisir une ligne: ")))) (setq dxf_line (entget (car ent))) (foreach n (list (list (cdr (assoc 10 dxf_line))) (list (cdr (assoc 11 dxf_line)))) (setq pt1 (car n) pt2 (car n)) (while (equal pt2 pt1) (setq pt2 ((lambda ( / key pt p1 p2 p3 p4 alpha) (princ "\nPosition de l'annotation du PR: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (setq pt (cadr key)) (setq alpha (angle pt1 pt)) (cond ((and (>= alpha 0.0) (< alpha (/ pi 2))) (setq p1 pt p2 (list (+ (car pt) 605) (cadr pt)) p3 (list (+ (car pt) 605) (+ (cadr pt) 430)) p4 (list (car pt) (+ (cadr pt) 430)) pt_w p1 ) ) ((and (>= alpha (/ pi 2)) (< alpha pi)) (setq p1 pt p2 (list (car pt) (+ (cadr pt) 430)) p3 (list (- (car pt) 605) (+ (cadr pt) 430)) p4 (list (- (car pt) 605) (cadr pt)) pt_w p4 ) ) ((and (>= alpha pi) (< alpha (/ (* 3 pi) 2))) (setq p1 pt p2 (list (- (car pt) 605) (cadr pt)) p3 (list (- (car pt) 605) (- (cadr pt) 430)) p4 (list (car pt) (- (cadr pt) 430)) pt_w p3 ) ) (T (setq p1 pt p2 (list (car pt) (- (cadr pt) 430)) p3 (list (+ (car pt) 605) (- (cadr pt) 430)) p4 (list (+ (car pt) 605) (cadr pt)) pt_w p2 ) ) ) (grdraw pt1 p1 1) (grdraw p1 p2 7) (grdraw p2 p3 7) (grdraw p3 p4 7) (grdraw p4 p1 7) ) ) ) (redraw) (cadr key) )) ) (if (equal pt2 pt1) (princ "\nLa position est confondue avec l'extrèmité du CD!") ) ) ) )) NB: concu pour une petite échelle, environ 1/100000 -
Voici ce que j'ai pu faire, cela me semble correct, mais sous réserve quand même. ((lambda ( / all_path end_pos id_path fonts_path all_path file_shx f caracter) (setq all_path (getenv "ACAD")) (while (setq end_pos (vl-string-position (ascii ";") all_path)) (setq id_path (substr all_path 1 end_pos)) (if (wcmatch (strcase id_path) "*FONTS*") (setq fonts_path (strcat id_path "\\")) ) (setq all_path (substr all_path (+ 2 end_pos))) ) (setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8)) (cond (file_shx (setq f (open file_shx "r")) (while (setq caracter (read-char f))) (setq caracter (read-char f)) (setq caracter (read-char f)) (if (zerop caracter) (princ "\nPolice NE pouvant PAS être orienté verticalement") (princ "\nPolice pouvant être orienté verticalement") ) (close f) ) ) (prin1) ))
-
Dans un fichier de police SHP (avant compilation) voici comment est définie une police: Extrait de l'aide AutoCAD Il doit être possible d'identifier également ceci dans un SHX, mais je n'ai pas la solution (l'info doit être au début du fichier). Si j'ai le temps, j'essayerais de regarder comment l'identifier. Cela éviterais de créer un style avec une police pour savoir si celle ci peut être orientée dans les 2 sens.
-
ligne en pointillés ronds de + de 2. 11
bonuscad a répondu à un(e) sujet de miamy dans AutoCAD LT 2004
Tu n'as jamais réussi à mettre cette SOLUTION en oeuvre? -
lisp pour dessiner un arc avec 2 Pt et sa longueur
bonuscad a répondu à un(e) sujet de willfrca dans Routines LISP
Ainsi que celui-ci -
C'est vrai que j'ai constaté ce problème de retour de ligne dans les fichier PAT d'origine, qui semblaient d'ailleurs correct dans la syntaxe, mais me retournaient quand même des erreurs de syntaxe lors du chargement du motif. (sur certain motifs seulement) Une édition en refaisant simplement les retours de lignes (ou/et les espaces) avaient résolu le problème.
-
créer une super calculatrice
bonuscad a répondu à un(e) sujet de sechanbask dans Personnalisation, macros, DIESEL
Et les fichiers pour une calculatrice scientifique utilisée en majorité par un grand nombre de personnes. (En notation polonaise, les gens cherchent toujours le signe = ) le lisp DDCAL.LSP (defun cvs (val com? / mod) (cond ((eq md_aun 0) (setq mod 180.0) ) ((eq md_aun 2) (setq mod 200.0) ) ((eq md_aun 3) (setq mod pi) ) ) (if com? (/ (* val 180) mod) (/ (* val mod) 180) ) ) (defun entry (numb / ) (if (eq numb ".") (setq numb "0.0") ) (cond ((eq (type (read numb)) 'REAL) (setq dec_? T) ) ((eq (type (read numb)) 'INT) (cond (md_arr (setq nbdec (atoi numb) md_arr nil rslt ms_pil) (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 0) ) ) (md_stk (setvar (strcat "USERR" numb) rslt) (setq entier "0" decima "." dec_? nil md_stk nil) (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "0" "6" "7" "8" "9" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 0) ) ) (md_rcl (if (not (getvar (strcat "USERR" numb))) (setq rslt 0.0) (setq rslt (getvar (strcat "USERR" numb))) ) (setq entier "0" decima "." dec_? nil md_rcl nil) (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "0" "6" "7" "8" "9" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 0) ) ) (T (if dec_? (setq decima (strcat decima numb)) (setq entier (itoa (atoi (strcat entier numb)))) ) (setq rslt (atof (strcat entier decima))) ) ) ) ((eq (type (read numb)) 'SYM) (cond ((eq numb "STO") (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "0" "6" "7" "8" "9" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 1) ) (setq md_stk T) ) ((eq numb "RCL") (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "0" "6" "7" "8" "9" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 1) ) (setq md_rcl T) ) ((eq numb "ABS") (setq rslt (cal "abs (rslt)") entier "0" decima "." dec_? nil) ) ((eq numb "ARR") (foreach n '("PICK" "STO" "RCL" "ABS" "ARR" "SIG" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PUI" "SQR" "INV" "CLS" "." "+" "-" "*" "/" "=" "accept") (mode_tile n 1) ) (setq ms_pil rslt md_arr T) ) ((eq numb "SIG") (setq rslt (cal "- rslt")) ) ((eq numb "ASI") (if (or (> rslt 1.0) (< rslt -1.0)) (alert "La valeur doit être comprise entre -1 et 1") (setq rslt (cvs (cal "asin (rslt)") nil) entier "0" decima "." dec_? nil) ) ) ((eq numb "ACO") (if (or (> rslt 1.0) (< rslt -1.0)) (alert "La valeur doit être comprise entre -1 et 1") (setq rslt (cvs (cal "acos (rslt)") nil) entier "0" decima "." dec_? nil) ) ) ((eq numb "ATA") (setq rslt (cvs (cal "atan (rslt)") nil) entier "0" decima "." dec_? nil) ) ((eq numb "PI") (setq rslt (cal "pi") entier "0" decima "." dec_? nil) ) ((eq numb "SIN") (setq rslt (cvs rslt T) rslt (cal "sin (rslt)") entier "0" decima "." dec_? nil) ) ((eq numb "COS") (setq rslt (cvs rslt T) rslt (cal "cos (rslt)") entier "0" decima "." dec_? nil) ) ((eq numb "TAN") (setq tmp (cvs rslt T)) (if (eq (abs (cal "sin (tmp)")) 1.0) (alert "Valeur de la tangente ne peut tendre vers l'infini") (setq rslt (cvs rslt T) rslt (cal "tang (rslt)") entier "0" decima "." dec_? nil) ) ) ((eq numb "PUI") (setq rslt (cal "sqr (rslt)") entier "0" decima "." dec_? nil) ) ((eq numb "SQR") (if (< rslt 0.0) (alert "Racine carré d'un nombre négatif impossible") (setq rslt (cal "sqrt (rslt)") entier "0" decima "." dec_? nil) ) ) ((eq numb "INV") (if (zerop rslt) (alert "Inverse de zéro impossible") (setq rslt (cal "1.0 / rslt") entier "0" decima "." dec_? nil) ) ) ((eq numb "CLS") (setq rslt 0.0 entier "0" decima "." dec_? nil) ) ((or (eq numb "+") (eq numb "-") (eq numb "*") (eq numb "/")) (setq ms_pil rslt rslt 0.0 entier "0" decima "." dec_? nil oper numb) ) ((eq numb "=") (setq rslt (cal (strcat "ms_pil" oper "rslt")) entier "0" decima "." dec_? nil) ) ) ) ) (set_tile "dsp" (rtos rslt 2 nbdec)) ) (defun c:DDCAL ( / old_zin md_aun rslt nbdec entier decima dec_? dcl_id what_next pt1 pt2 ms_pil oper md_arr md_stk md_rcl) (if (not (member T (mapcar '(lambda (x) (wcmatch (strcase x) "GEOMCAL.ARX")) (arx)))) (arxload "geomcal") ) (setq old_zin (getvar "dimzin")) (setvar "dimzin" 0) (setq rslt 0.0 nbdec (getvar "luprec")) (setq entier "0" decima "." dec_? nil md_aun 0) (setq dcl_id (load_dialog "ddcal")) (setq what_next 2) (while (> what_next 1) (if (not (new_dialog "ddcal" dcl_id)) (exit)) (cond ((eq md_aun 0) (set_tile "DG" "1") (mode_tile "DG" 2) ) ((eq md_aun 3) (set_tile "RD" "1") (mode_tile "RD" 2) ) ((eq md_aun 2) (set_tile "GR" "1") (mode_tile "GR" 2) ) ) (set_tile "dsp" (rtos rslt 2 nbdec)) (action_tile "PICK" "(done_dialog 2)") (action_tile "STO" "(entry $key)") (action_tile "RCL" "(entry $key)") (action_tile "ABS" "(entry $key)") (action_tile "ARR" "(entry $key)") (action_tile "DG" "(setq md_aun 0)") (action_tile "RD" "(setq md_aun 3)") (action_tile "GR" "(setq md_aun 2)") (action_tile "SIG" "(entry $key)") (action_tile "ASI" "(entry $key)") (action_tile "ACO" "(entry $key)") (action_tile "ATA" "(entry $key)") (action_tile "PI" "(entry $key)") (action_tile "SIN" "(entry $key)") (action_tile "COS" "(entry $key)") (action_tile "TAN" "(entry $key)") (action_tile "PUI" "(entry $key)") (action_tile "SQR" "(entry $key)") (action_tile "INV" "(entry $key)") (action_tile "CLS" "(entry $key)") (action_tile "7" "(entry $key)") (action_tile "8" "(entry $key)") (action_tile "9" "(entry $key)") (action_tile "-" "(entry $key)") (action_tile "4" "(entry $key)") (action_tile "5" "(entry $key)") (action_tile "6" "(entry $key)") (action_tile "+" "(entry $key)") (action_tile "1" "(entry $key)") (action_tile "2" "(entry $key)") (action_tile "3" "(entry $key)") (action_tile "*" "(entry $key)") (action_tile "0" "(entry $key)") (action_tile "." "(entry $key)") (action_tile "=" "(entry $key)") (action_tile "/" "(entry $key)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) (cond ((= what_next 2) (initget 41) (setq pt1 (getpoint "\nPremier point: ")) (initget 41) (setq pt2 (getpoint "\nSecond point: ")) (initget "Distance Angle") (if (eq (getkword "\n[Distance/Angle] : ") "Angle") (setq rslt (cvs (cal "ang (pt1,pt2)") nil)) (setq rslt (cal "dist (pt1,pt2)")) ) ) ) ) (unload_dialog dcl_id) (setvar "dimzin" old_zin) (if (not (zerop what_next)) (if (< nbdec 9) (read (rtos rslt 2 nbdec)) rslt ) ) ) le dcl DDCAL.DCL ddcal : dialog { label = "Calculette"; :boxed_row { :text { key = "dsp"; width = 15; } } :row { :button { label = ">> Saisie graphique"; key = "PICK"; } } :row { :radio_button { label = "Dg"; key = "DG"; } :radio_button { label = "Rd"; key = "RD"; } :radio_button { label = "Gr"; key = "GR"; } } :row { :column { width = 10; :button { label = "Abs"; key = "ABS"; } :button { label = "±"; key = "SIG"; } :button { label = "¶"; key = "PI"; } :button { label = "x²"; key = "PUI"; } :button { label = "7"; key = "7"; } :button { label = "4"; key = "4"; } :button { label = "1"; key = "1"; } :button { label = "0"; key = "0"; } } :column { width = 10; :button { label = "Arr"; key = "ARR"; } :button { label = "aSi"; key = "ASI"; } :button { label = "Sin"; key = "SIN"; } :button { label = "V¯"; key = "SQR"; } :button { label = "8"; key = "8"; } :button { label = "5"; key = "5"; } :button { label = "2"; key = "2"; } :button { label = "."; key = "."; } } :column { width = 10; :button { label = "Sto"; key = "STO"; } :button { label = "aCo"; key = "ACO"; } :button { label = "Cos"; key = "COS"; } :button { label = "1/x"; key = "INV"; } :button { label = "9"; key = "9"; } :button { label = "6"; key = "6"; } :button { label = "3"; key = "3"; } :button { label = "="; key = "="; } } :column { width = 10; :button { label = "Rcl"; key = "RCL"; } :button { label = "aTa"; key = "ATA"; } :button { label = "Tan"; key = "TAN"; } :button { label = "CLS"; key = "CLS"; } :button { label = "-"; key = "-"; } :button { label = "+"; key = "+"; } :button { label = "X"; key = "*"; } :button { label = "÷"; key = "/"; } } } ok_cancel; } -
créer une super calculatrice
bonuscad a répondu à un(e) sujet de sechanbask dans Personnalisation, macros, DIESEL
Voici un lisp + le dcl associé qui permettent d'émuler une une calculatrice transparente pour les commande standard d'autocad, ne peut être employé à la suite d'un appel d'un autre lisp: c'est à dire fournir un calcul pour une commande crée en lisp. Ces fichiers devront être placés dans un dossier de recherche d'autocad. Puis créez un nouveau bouton contenant la syntaxe suivante: 'DDCAL (pas de ^C^C proposé par défault lors de la création du bouton) Un inconvénient et que la saisie numérique ne peut être faite qu'au pointeur de la souris, et non au clavier. Vous aurez l'usage d'une calcultrice scientifique avec la possibilité d'acquérir des valeurs graphiques (longueur ou angulaire) Ce lisp se décline sous deux versions, celle proposé dans ce post est en notation polonaise (utilisant la mise en pile, comme les anciennes calculatrices HP) pas de paranthèses mais usage NOMBRE mise en pile par ENTER puis SECOND NOMBRE et OPERATION à effectuer. C'est celle que je préfère pour faire du calcul enchainé Je fais un second post pour une calculatrice scientifique standard : NOMBRE OPERATION NOMBRE "=" Le lisp DDCAL.LSP (defun fc_cal (op val) (setq l_stk (append (cdr l_stk) '(0.0))) (cal (strcat op " (val)")) ) (defun ms_pil (val / ) (cons val (reverse (cdr (reverse l_stk)))) ) (defun cvs (val com? / mod) (cond ((eq md_aun 0) (setq mod 180.0) ) ((eq md_aun 2) (setq mod 200.0) ) ((eq md_aun 3) (setq mod pi) ) ) (if com? (/ (* val 180) mod) (/ (* val mod) 180) ) ) (defun fcprss (fonc / tmp r1 r2) (setq first T) (setq entier "0" decima "." dec_? nil md_stk nil) (cond (md_mem (setvar "userr1" (eval (read (strcat "(" fonc "(getvar " "\"USERR1" "\") (car l_stk))")))) (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "7" "8" "9" "6" "5" "4" "3" "2" "1" "0" "." "DSP" "accept") (mode_tile n 0) ) (setq md_mem nil) ) (T (cond ((eq fonc "DSP") (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "+" "*" "/" "." "DSP" "accept") (mode_tile n 1) ) (setq md_dsp T) ) ((eq fonc "STO") (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "7" "8" "9" "+" "6" "*" "/" "0" "." "DSP" "accept") (mode_tile n 1) ) (setq md_stk T) ) ((eq fonc "RCL") (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "7" "8" "9" "+" "6" "*" "/" "0" "." "DSP" "accept") (mode_tile n 1) ) (setq md_rcl T) ) ((eq fonc "MOP") (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "7" "8" "9" "6" "5" "4" "3" "2" "1" "0" "." "DSP" "accept") (mode_tile n 1) ) (setq md_mem T) ) ((eq fonc "SIG") (setq l_stk (ms_pil (fc_cal "-" (car l_stk)))) ) ((eq fonc "ASI") (if (or (> (car l_stk) 1.0) (< (car l_stk) -1.0)) (alert "La valeur doit être comprise entre -1 et 1") (setq l_stk (ms_pil (cvs (fc_cal "asin" (car l_stk)) nil))) ) ) ((eq fonc "ACO") (if (or (> (car l_stk) 1.0) (< (car l_stk) -1.0)) (alert "La valeur doit être comprise entre -1 et 1") (setq l_stk (ms_pil (cvs (fc_cal "acos" (car l_stk)) nil))) ) ) ((eq fonc "ATA") (setq l_stk (ms_pil (cvs (fc_cal "atan" (car l_stk)) nil))) ) ((eq fonc "PI") (setq l_stk (ms_pil (cal "pi"))) ) ((eq fonc "SIN") (setq l_stk (ms_pil (fc_cal "sin" (cvs (car l_stk) T)))) ) ((eq fonc "COS") (setq l_stk (ms_pil (fc_cal "cos" (cvs (car l_stk) T)))) ) ((eq fonc "TAN") (setq tmp (cvs (car l_stk) T)) (if (eq (abs (cal "sin (tmp)")) 1.0) (alert "Valeur de la tangente ne peut tendre vers l'infini") (setq l_stk (ms_pil (fc_cal "tang" (cvs (car l_stk) T)))) ) ) ((eq fonc "PU2") (setq l_stk (ms_pil (fc_cal "sqr" (car l_stk)))) ) ((eq fonc "SQR") (if (< (car l_stk) 0.0) (alert "Racine carré d'un nombre négatif impossible") (setq l_stk (ms_pil (fc_cal "sqrt" (car l_stk)))) ) ) ((eq fonc "INV") (if (zerop (car l_stk)) (alert "Inverse de zéro impossible") (setq l_stk (ms_pil (fc_cal "1.0 /" (car l_stk)))) ) ) ((eq fonc "CLR") (setq l_stk '(0.0 0.0 0.0 0.0)) ) ((eq fonc "CLX") (setq l_stk (append (cdr l_stk) '(0.0))) ) ((eq fonc "ST_UP") (setq l_stk (ms_pil (car l_stk)) first nil) ) ((eq fonc "ST_DW") (setq l_stk (append (cdr l_stk) (list (car l_stk)))) ) ((or (eq fonc "+") (eq fonc "-") (eq fonc "*") (eq fonc "/") (eq fonc "^")) (setq r1 (car l_stk) r2 (cadr l_stk) l_stk (append (cddr l_stk) '(0.0 0.0))) (setq l_stk (ms_pil (cal (strcat "r2" fonc "r1")))) ) ) (set_tile "DISPLAY" (rtos (car l_stk) 2 nbdec)) ) ) ) (defun nbprss (numb / ) (if (eq numb ".") (setq numb "0.0") ) (cond (md_dsp (setq nbdec (atoi numb) md_dsp nil) (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "7" "8" "9" "+" "6" "*" "/" "0" "." "DSP" "accept") (mode_tile n 0) ) (set_tile "DISPLAY" (rtos (car l_stk) 2 nbdec)) ) (md_stk (setvar (strcat "USERR" numb) (car l_stk)) (setq entier "0" decima "." dec_? nil md_stk nil) (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "7" "8" "9" "+" "6" "*" "/" "0" "." "DSP" "accept") (mode_tile n 0) ) ) (md_rcl (if (not (getvar (strcat "USERR" numb))) (setq l_stk (ms_pil 0.0)) (setq l_stk (ms_pil (getvar (strcat "USERR" numb)))) ) (setq entier "0" decima "." dec_? nil md_rcl nil) (foreach n '("PICK" "STO" "RCL" "MOP" "SIG" "^" "ASI" "ACO" "ATA" "PI" "SIN" "COS" "TAN" "PU2" "SQR" "INV" "CLR" "ST_UP" "ST_DW" "CLX" "-" "7" "8" "9" "+" "6" "*" "/" "0" "." "DSP" "accept") (mode_tile n 0) ) ) (T (cond ((eq (type (read numb)) 'REAL) (setq dec_? T) ) (T (if dec_? (setq decima (strcat decima numb)) (setq entier (itoa (atoi (strcat entier numb)))) ) (if first (setq l_stk (ms_pil (atof (strcat entier decima))) first nil) (setq l_stk (cons (atof (strcat entier decima)) (cdr l_stk))) ) ) ) ) ) (set_tile "DISPLAY" (rtos (car l_stk) 2 nbdec)) ) (defun c:DDCAL ( / old_zin md_aun nbdec entier decima dec_? first l_stk dcl_id what_next pt1 pt2 md_dsp md_stk md_rcl md_mem) (if (not (member T (mapcar '(lambda (x) (wcmatch (strcase x) "GEOMCAL.ARX")) (arx)))) (arxload "geomcal") ) (setq old_zin (getvar "dimzin") md_aun 0 nbdec (getvar "luprec") entier "0" decima "." dec_? nil first T l_stk '(0.0 0.0 0.0 0.0) dcl_id (load_dialog "ddcal") what_next 2 ) (setvar "dimzin" 0) (while (> what_next 1) (if (not (new_dialog "ddcal" dcl_id)) (exit)) (cond ((eq md_aun 0) (set_tile "DG" "1") (mode_tile "DG" 2) ) ((eq md_aun 3) (set_tile "RD" "1") (mode_tile "RD" 2) ) ((eq md_aun 2) (set_tile "GR" "1") (mode_tile "GR" 2) ) ) (set_tile "DISPLAY" (rtos (car l_stk) 2 nbdec)) (action_tile "PICK" "(done_dialog 2)") (action_tile "STO" "(fcprss $key)") (action_tile "RCL" "(fcprss $key)") (action_tile "MOP" "(fcprss $key)") (action_tile "SIG" "(fcprss $key)") (action_tile "DG" "(setq md_aun 0)") (action_tile "RD" "(setq md_aun 3)") (action_tile "GR" "(setq md_aun 2)") (action_tile "^" "(fcprss $key)") (action_tile "ASI" "(fcprss $key)") (action_tile "ACO" "(fcprss $key)") (action_tile "ATA" "(fcprss $key)") (action_tile "PI" "(fcprss $key)") (action_tile "SIN" "(fcprss $key)") (action_tile "COS" "(fcprss $key)") (action_tile "TAN" "(fcprss $key)") (action_tile "PU2" "(fcprss $key)") (action_tile "SQR" "(fcprss $key)") (action_tile "INV" "(fcprss $key)") (action_tile "CLR" "(fcprss $key)") (action_tile "ST_UP" "(fcprss $key)") (action_tile "ST_DW" "(fcprss $key)") (action_tile "CLX" "(fcprss $key)") (action_tile "-" "(fcprss $key)") (action_tile "7" "(nbprss $key)") (action_tile "8" "(nbprss $key)") (action_tile "9" "(nbprss $key)") (action_tile "+" "(fcprss $key)") (action_tile "4" "(nbprss $key)") (action_tile "5" "(nbprss $key)") (action_tile "6" "(nbprss $key)") (action_tile "*" "(fcprss $key)") (action_tile "1" "(nbprss $key)") (action_tile "2" "(nbprss $key)") (action_tile "3" "(nbprss $key)") (action_tile "/" "(fcprss $key)") (action_tile "0" "(nbprss $key)") (action_tile "." "(nbprss $key)") (action_tile "DSP" "(fcprss $key)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) (cond ((= what_next 2) (initget 41) (setq pt1 (getpoint "\nPremier point: ")) (initget 41) (setq pt2 (getpoint "\nSecond point: ")) (initget "Distance Angle") (if (eq (getkword "\n[Distance/Angle] : ") "Angle") (setq l_stk (ms_pil (cvs (cal "ang (pt1,pt2)") nil))) (setq l_stk (ms_pil (cal "dist (pt1,pt2)"))) ) ) ) ) (unload_dialog dcl_id) (setvar "dimzin" old_zin) (if (not (zerop what_next)) (if (< nbdec 9) (read (rtos (car l_stk) 2 nbdec)) (car l_stk) ) ) ) le dcl DDCAL.DCL ddcal : dialog { label = "Calculette"; :row { :text { label = "Hewlett Packard"; } } :boxed_row { :text { key = "DISPLAY"; width = 15; } } :row { :button { label = ">> Saisie graphique"; key = "PICK"; } } :row { :radio_button { label = "Dg"; key = "DG"; } :radio_button { label = "Rd"; key = "RD"; } :radio_button { label = "Gr"; key = "GR"; } } :row { :column { width = 10; :button { label = "M1f"; key = "MOP"; } :button { label = "Y^x"; key = "^"; } :button { label = "¶"; key = "PI"; } :button { label = "x²"; key = "PU2"; } } :column { width = 10; :button { label = "±"; key = "SIG"; } :button { label = "aSI"; key = "ASI"; } :button { label = "Sin"; key = "SIN"; } :button { label = "V¯"; key = "SQR"; } } :column { width = 10; :button { label = "STO"; key = "STO"; } :button { label = "aCO"; key = "ACO"; } :button { label = "Cos"; key = "COS"; } :button { label = "1/x"; key = "INV"; } } :column { width = 10; :button { label = "RCL"; key = "RCL"; } :button { label = "aTA"; key = "ATA"; } :button { label = "Tan"; key = "TAN"; } :button { label = "CLR"; key = "CLR"; } } } :row { :column { width = 20; :button { label = " -> ENTER "; key = "ST_UP"; } } :column { width = 10; :button { label = "<-R"; key = "ST_DW"; } } :column { width = 10; :button { label = "CLx"; key = "CLX"; } } } :row { :column { width = 10; :button { label = "-"; key = "-"; } :button { label = "+"; key = "+"; } :button { label = "X"; key = "*"; } :button { label = "÷"; key = "/"; } } :column { width = 10; :button { label = "7"; key = "7"; } :button { label = "4"; key = "4"; } :button { label = "1"; key = "1"; } :button { label = "0"; key = "0"; } } :column { width = 10; :button { label = "8"; key = "8"; } :button { label = "5"; key = "5"; } :button { label = "2"; key = "2"; } :button { label = "."; key = "."; } } :column { width = 10; :button { label = "9"; key = "9"; } :button { label = "6"; key = "6"; } :button { label = "3"; key = "3"; } :button { label = "DSP"; key = "DSP"; } } } ok_cancel; } NB Ces fichiers devront être chargés au démarrage d'autocad pour fonctionner. C'est quand même un peu pour le "fun" car l'usage de la commande calc d'autocad fait très bien l'affaire. -
Autocad vers Photoshop
bonuscad a répondu à un(e) sujet de grandsteak44 dans Pour aller plus loin en LISP
Une procédure qui date un peu ... mais déjà une bonne base s'il faut modifier quelque trucs (defun epserr (ch) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (command "_.undo" "1") (setq *error* olderr) (setvar "expert" drap) (setvar "textfill" fill_txt) (setvar "filedia" dia_file) (setvar "cmdecho" 1) (princ) ) (defun c:layer2eps ( / curr_layer next_layer name_layer drap sv_und olderr fill_txt dia_file name_file typ_plot pt1 pt2 name_view unit_plot scale_plot format_page prefix_folder) (setvar "cmdecho" 0) (setq drap (getvar "expert")) (setq fill_txt (getvar "textfill")) (setq dia_file (getvar "filedia")) (setvar "textfill" 1) (setvar "filedia" 0) (setvar "expert" 5) (if (<= (setq sv_und (getvar "undoctl")) 3) (command "_.undo" "_control" "_all") ) (command "_.undo" "_group") (setq olderr *error* *error* epserr) (setq name_file (getfiled "Créer un fichier PosScript" "0" "eps" 33)) (initget "Affichage Etendue Limites Vue Fenêtre _Display Extent Limits View Window") (if (not (setq typ_plot (getkword "\nQue tracer: Affichage, Etendue, Limites, Vue ou Fenêtre : "))) (setq typ_plot "Display") ) (cond ((eq typ_plot "Window") (initget 9) (setq pt1 (getpoint "\nSpécifiez le premier coin: ")) (initget 9) (setq pt2 (getcorner pt1 " Spécifiez le coin opposé: ")) ) ((eq typ_plot "View") (while (null (tblsearch "VIEW" (setq name_view (getstring T "\nNom de la vue: ")))) (princ (strcat "\nLa vue " name_view " n'a pas été trouvée.\n*Incorrect*")) ) ) ) (initget "Pouce Millimètre _Inches Millimeter") (if (not (setq unit_plot (getkword "\nEntrez les unités [Pouces/Millimètres] : "))) (setq unit_plot "Millimeter") ) (setq scale_plot (getstring "\nEntrez l'échelle de tracer sous la forme 1=2 ou F pour ajuster à la page: ")) (textscr) (princ "\nValeurs standard pour le format de sortie") (princ "\nFormat Largeur Hauteur") (princ "\nA 8.00 10.50") (princ "\nB 10.00 16.00") (princ "\nC 16.00 21.00") (princ "\nD 21.00 33.00") (princ "\nE 33.00 43.00") (princ "\nF 28.00 40.00") (princ "\nG 11.00 90.00") (princ "\nH 28.00 143.00") (princ "\nJ 34.00 176.00") (princ "\nK 40.00 143.00") (princ "\nA4 7.80 11.20") (princ "\nA3 10.70 15.60") (princ "\nA2 15.60 22.40") (princ "\nA1 22.40 32.20") (princ "\nA0 32.20 45.90") (princ "\nUTILISATEUR 10.75 15.59") (initget 8 "A B C D E F G H I J K A4 A3 A2 A1 A0 UTILISATEUR _A B C D E F G H I J K A4 A3 A2 A1 A0 USER") (if (null (setq format_page (getpoint "\nEntrez le format, ou la largeur,hauteur (en Pouces) : "))) (setq format_page "A4") ) (princ "\nReinitialise tous les plans dans la vue courante - Patientez S.V.P. !") (command "_.-layer" "_thaw" "*" "_unlock" "*" "_set" "0" "_off" "*" "_on" "0" "") (princ "\nSélectionne le calque 0") (command "_.psout" name_file (strcat "_" typ_plot)) (cond ((eq typ_plot "Window") (command pt1 pt2)) ((eq typ_plot "View") (command name_view)) ) (command "_none" (strcat "_" unit_plot) scale_plot) (if (listp format_page) (command (strcat (rtos (car format_page) 2 2) "," (rtos (cadr format_page) 2 2))) (command (strcat "_" format_page)) ) (setq curr_layer (getvar "clayer") next_layer (tblnext "LAYER" T) ) (if (setq next_layer (tblnext "LAYER")) (setq name_layer (cdr (assoc 2 next_layer))) (setq name_layer "0") ) (setq prefix_folder (substr name_file 1 (- (strlen name_file) 5))) (while (/= curr_layer name_layer) (if (/= curr_layer name_layer) (progn (command "_.-layer" "_off" "*" "_on" name_layer "") (princ (strcat "\nSélectionne le calque " name_layer)) (setq name_file (strcat prefix_folder name_layer ".eps")) (command "_.psout" name_file (strcat "_" typ_plot)) (cond ((eq typ_plot "Window") (command pt1 pt2)) ((eq typ_plot "View") (command name_view)) ) (command "_none" (strcat "_" unit_plot) scale_plot) (if (listp format_page) (command (strcat (rtos (car format_page) 2 2) "," (rtos (cadr format_page) 2 2))) (command (strcat "_" format_page)) ) ) ) (setq next_layer (tblnext "LAYER")) (if (null next_layer) (setq next_layer (tblnext "LAYER" T)) ) (setq name_layer (cdr(assoc 2 next_layer))) ) (princ "\nTous les calques ont été tracés en fichiers EPS dans l'espace courant.\n Commande terminée...") (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (command "_.undo" "1") (setq *error* olderr) (setvar "expert" drap) (setvar "textfill" fill_txt) (setvar "filedia" dia_file) (setvar "cmdecho" 1) (princ) ) -
Tranformer ligne2d / a des points 3d
bonuscad a répondu à un(e) sujet de lovecraft dans Débuter en LISP
Pour des LWPOLYLINE, avec les mêmes restrictions que gilles (zoom, scg ...) sans fonction de test de sélection ni contrôle d'erreur. Donc à peaufiner.... ((lambda ( / l_2d l_z l_3d) (setq l_2d (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget (car (entsel)))))) (setq l_z (mapcar '(lambda (x) (setq js (ssget "_C" x x '((0 . "POINT")))) (if js (caddr (cdr (assoc 10 (entget (ssname js 0))))) 0.0 ) ) l_2d ) ) (setq l_3d (mapcar 'append l_2d (mapcar 'list l_z))) (command "_.3dpoly") (repeat (length l_3d) (command "_none" (car l_3d)) (setq l_3d (cdr l_3d)) ) (command "") )) -
Ah OK cette version fonctionne mieux Mais on est obligé pour les nouvelles fenêtres de passer par le verrouillage pour que le reacteur entre en action, cela serait mieux qu'il soit effectif lors de l'utilisation de FMULT. Mais déjà le résultat est interressant pour une première fois. Je n'est pas encore fait de tests approfondis, et je suis pas sur que d'imposer un calque soit une bonne idée (on peut vouloir par exemple un tracage de contour pour certaines fenêtre et pour d'autres non)
-
Disons plutôt que j'ai donné un lien, qui t'as donné l'idée ;) J'ai essayé ton lisp sous une 2002, mais que rien ne se passe (pas de message d'erreurs pourtant) Pas de dé/verrouillages de fenêtres, pas de mise en couleur, pas de création de calque..... :( Je ne comprends pas le but de faire un réacteur; pour placer les fenêtres sur le calque spécifique? J'essayerais sous une 2005 pour voir, peut être que je comprendrais alors l'utilité. Mais je comprends aussi que c'est un coup d'essai, Patrick_35 te sera de bon conseil :exclam: Voici la routine que j'avais trouvé, je retrouve pas de liens (ça m"embête un peu pour l'auteur) mais je farfouille tellement partout que je n'ai plus aucune idée sur quel site j'ai pu trouvé celui-ci. (prompt "\nEnter VPL to Lock all Viewports ") (prompt "\nEnter VPU to UnLock all Viewports ") (vl-load-com) (defun c:VPU () ; (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object) ) ) (if (eq :vlax-false (vla-get-modeltype lay)) (vlax-for ent (vla-get-block lay) ; for each ent in layout (if (= (vla-get-objectname ent) "AcDbViewport") (progn (vla-put-displaylocked ent :vlax-false) (vla-put-color ent 3); 3 green ) ) ) ) ) (princ) ) (defun c:VPL () ; 07/07/04 (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object) ) ) (if (eq :vlax-false (vla-get-modeltype lay)) (vlax-for ent (vla-get-block lay) ; for each ent in layout (if (= (vla-get-objectname ent) "AcDbViewport") (progn (vla-put-displaylocked ent :vlax-true) (vla-put-color ent 256);256 bylayer ) ) ) ) ) (princ) ) NB: lui avait choisi le vert pour déverrouillé et la couleur du calque pour verrouillé :P A ça y est, j'ai retrouvé le lien Post de Jason Rhymes dans ce fil de discussion [Edité le 3/12/2006 par bonuscad]
