-
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
-
Après un test, avec les dll c'est OK sous Map2014. J'ai déjà eu besoin de ce style de détail que je faisais alors avec des fmult polygonale en espace papier: c'est bien aussi mais un peu plus pénible à mettre en place. Là c'est beaucoup plus rapide, mais il faut surveiller la géométrie originale qui pourrait changer et ne pas oublier de refaire le détail. J'aurai bien soumis l'idée des MPOLYGON, mais comme elles sont proches des entités HATCH qui ne sont pas incluses, j'ai peur que mon souhait ne soit pas réalisable. Mais je garde ce dll sous le coude, il est fort probable qu'il puisse me servir. Merci pour le partage.
-
Bonjour, Je ne voudrais pas être rabat-joie, mes tes applications en Net ne sont souvent accessible que pour ceux qui sont administrateur de leur poste. Dès qu'on est en entreprise, plus moyen de profiter de quoi que ce soit. Bien sur on peut demander aux admins, mais ils sont souvent réticents à tout plug-in installé en admin, ou alors il faut palabrer des heures pour dire que c'est inoffensif. Donc ça doit être très bien, mais je ne peux en juger...
-
Dans quel traceur investir ?
bonuscad a répondu à un(e) sujet de DenisHen dans Périphériques de sortie, impression
Autrement pour revenir à la question initial. J'utilise (enfin on utilise, car partagé): HP DesignJet T1300 Il résiste bien, pour l'instant. Sachant que les utilisateurs n'ont que faire du suivi (ça passe ou sa casse: extinction brutale, cartouches ou têtes d'impression périmées, grammage papier mal défini et j'en passe...) Je ne pourrais dire combien de rouleaux ont été imprimés,...: seulement beaucoup! Vu le prix, il vaut mieux avoir un volume d'impression conséquent... -
Dans quel traceur investir ?
bonuscad a répondu à un(e) sujet de DenisHen dans Périphériques de sortie, impression
Au commencement était: (je refais la genèse :(rires forts): ) Autocad 9 sous DOS Un ordinateur Goupil XT 286 Un écran Viking fonctionnant avec une carte graphique Power9 (celui là il m'a éclaté les yeux). Pas retrouver de photo, c'était un monstre... Une tablette à digitaliser Summasketch III ET un traceur à plume Benson 1635 SR : impressionnant de voir cette feuille circuler à vive allure, ça pouvait couper comme un rasoir si l'on laisser trainer les doigts près de la feuille. -
Retour d'une application externe
bonuscad a répondu à un(e) sujet de Fraid dans Pour aller plus loin en LISP
Bonjour, Avec CECI? (defun Sleep (n / lastCmdecho ) (setq lastCmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (eval (list 'VL-CMDF "_.delay" n ) ) (setvar "cmdecho" lastCmdecho ) ) (defun C:ExternalApplication ( / *error* ) (defun *error* ( msg / ) (if (not (null msg ) ) (progn (princ "\nC:ExternalApplication:*error*: " ) (princ msg ) (princ "\n") ) ) ) (setq path "C:\\Windows\\") (setq app (strcat "Notepad.exe" ) ) (print (strcat "Run " (strcat path app ) ) ) (setq Shell (vlax-get-or-create-object "Wscript.Shell")) (setq AppHandle(vlax-invoke-method Shell 'Exec (strcat path app ) )) (while ( = (vlax-get-property AppHandle 'Status ) 0) (Sleep 1000) )` (vlax-release-object Shell) (print "Process finished" ) ) -
Orientation d'un bloc à la vertical
bonuscad a répondu à un(e) sujet de Sébastien65 dans AutoCAD 2016
A adapter, mais le principe est là pour être plus rapide en exécution que par _QSELECT ((lambda ( / js n dxf_ent) (setq js (ssget "_X" '((0 . "INSERT") (67 . 0) (2 . "PC 2P+T 16A")))) (cond (js (repeat (setq n (sslength js)) (setq dxf_ent (entget (ssname js (setq n (1- n))))) (entmod (subst (cons 50 0.0) (assoc 50 dxf_ent) dxf_ent)) ) ) ) (prin1) )) -
Orientation d'un bloc à la vertical
bonuscad a répondu à un(e) sujet de Sébastien65 dans AutoCAD 2016
Pour ma part, je dirais alors rester en bloc simple. Il fait tout ses manips qui désire (rotations, copie, déplacement...) sans se préoccuper de la représentation. Une fois que toutes sa mise en place est faite, alors un "_QSELECT" appliquer au "dessin entier" avec comme type d'objet une "Référence de bloc" et la propriété sur "Nom", opérateur "= Egal a" et la valeur "PC 2P+T 16A" Tout ça inclus dans un nouveau jeu de sélection. Dans la palette de propriété dans Divers -> "Rotation": remplacer "*VARIE*" par 0 et c'est fini. -
Orientation d'un bloc à la vertical
bonuscad a répondu à un(e) sujet de Sébastien65 dans AutoCAD 2016
Bonjour, En 2 Actions? Tu insère ton bloc à la position voulu (sans rotation à l'insertion) Une fois inséré, tu as 2 actions de rotation: Le plus proche du quadrant pour l'orientation générale, et celui un peu plus éloigné pour l'orientation te ta mire; se mettre en mode ortho pour faire ça graphiquement. PC_2P_T_16A.dwg -
Bonjour, Pour ceux que ça intéresse; je pense avoir corrigé le comportement notifié par Nighthawk. Pour info: En fait le programme ne tient pas compte du sens de la polyligne (même si dans ce cas ça pouvait résoudre le souci) car l'orientation du talus est faite par un calcul vectoriel. Le lisp peut être rechargé dans le lien du message initial de Nighthawk ou en direct Talus3D.lsp
-
[RESOLU] 2 textes multiligne, même hauteur de texte, deux tailles de texte différentes
bonuscad a répondu à un(e) sujet de zza427 dans AutoCAD 2018
Bonjour, Pour ce faire, je te conseil le lisp StripMtext v5.0 -
Bonjour, Effectivement j'ai essayé avec ton fichier et le talus n'est pas mis dans la bonne direction. Un bug de ma part sur la détermination du coté lors de la sélection du bas de talus dans un scu quelconque. Ce que je te suggère pour te sortir de la panade est de simplement retourner dans le SCG le temps d'exécuter la commande talus, puis de revenir dans ton SCU (si tu le désire) Il faudra que je corrige ce petit dysfonctionnement...
-
A priori tous tes blocs contiennent le mot "-flat-", donc en modifiant la ligne: (ssget (list '(0 . "INSERT") '(2 . "COTEH*,COTEB*,PCOTED*") (cons 410 (getvar "ctab")))) par (ssget (list '(0 . "INSERT") '(2 . "*-flat-*") (cons 410 (getvar "ctab")))) la routine devrait mettre tout les points en 3D en lieu et place de tous les blocs. Je n'ai pas vérifié (vu que tu as résolu ton problème) si tous les bloc n'avait qu'un attribut (transformable en réel), mais à priori c'est le cas. Mais si tu as réussi à obtenir tes points de source sure, c'est mieux.
-
Bonjour, Sans pouvoir vraiment tester... faute de dessin exemple. Mais ceci pour mettre des points en 3D depuis tes blocs, ferait-il l'affaire? ((lambda ( / doc sel text posxy) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (cond ((ssget (list '(0 . "INSERT") '(2 . "COTEH*,COTEB*,PCOTED*") (cons 410 (getvar "ctab")))) (vlax-for bl (setq sel (vla-get-activeselectionset doc)) (cond ((wcmatch (vla-get-EffectiveName bl) "*COTE*") (foreach pr (vlax-invoke bl 'GetAttributes) (setq text (vlax-get-property pr 'TextString)) (setq posxy (vlax-get bl 'InsertionPoint)) (entmake (list (cons 0 "POINT") (cons 100 "AcDbEntity") (cons 410 (getvar "ctab")) (cons 8 (getvar "clayer")) (cons 100 "AcDbPoint") (cons 10 (list (car posxy) (cadr posxy) (atof text))) ) ) ) ) ) ) ) ) (prin1) ))
-
Comme deux explications valent mieux qu'une... Les touches de déplacement permettent de faire glisser les tuiles dans le sens choisi, soit par colonnes, soit par rangées. Si lors de ce déplacement, deux tuiles (donc une paire) de même valeur se touchent bord à bord, alors celles-ci fusionnent pour s'additionner et obtenir une seule tuile (tu gagne un nouvel emplacement libre pour les mouvements futur). A chaque mouvement une nouvelle tuile apparait à un emplacement libre aléatoire de valeur 2 ou 4. Donc le but et de glisser les tuiles de façon à les additionner pour le coup à jouer ou le coup suivant. Le but ultime étant d'obtenir la tuile de valeur 2048. Un exemple de glissement en rangée de gauche à droite: (ici sur une seule ligne, dans le jeu c'est sur toutes les lignes) (2 0 2 16) -> (0 0 4 16) (4 4 4 8) -> (0 4 8 8): le coup suivant tu obtiendrait (en considérant qu'une nouvelle tuile ne soit pas apparue dans la rangée) -> (0 0 4 16) (2 16 0 8) -> (0 2 16 8): aucune addition faite, les tuiles ont juste glissées. Pour gagner, il parait qu'il faut coincer la tuile de plus haute valeur dans un coin et éviter de la déplacer (plus facile à dire qu'à faire) et avoir les tuiles de valeur dégressive proche de la plus haute, c'est la tactique que j'emploie, mais cela ne me fait pas gagner à tout les coups (loin de là).
-
Bonjour à tous J'ai modifié le code original posté plus haut. L'addition des nombres est plus fidèle à l'original de Gabrielle Cirulli, ce qui n'était pas le cas avant (il brulait des étapes et l'addition des tuiles n'était pas toujours dans le bon ordre. Amusez vous bien et joyeux Noël 2017
-
Faire un dessin propre
bonuscad a répondu à un(e) sujet de Aleck_Ultimate dans Organisation du travail
??? Avec 50m en millimètre, tu devrais être largement dans les clous. Bon tu donne les dimension de ton projet, mais pas sa situation. Quel est la valeur de LIMMIN , LIMMAX et aussi tant qu'on y est EXTMIN et EXTMAX Si elles sont du même ordre, tu devrait pas avoir de problème du genre que j'ai décris. Un extrait de dessin avec des objets qui posent problème pour cerner éventuellement un autre souci parce que là, je vois pas. -
Faire un dessin propre
bonuscad a répondu à un(e) sujet de Aleck_Ultimate dans Organisation du travail
Pour t’éclaircir un peu: En résumé Autocad n'est qu'un logiciel de calcul qui expose ses résultats graphiquement. Si dans la grande majorité des cas ses calculs sont "véritablement" exact, il arrive que le résultat soit approximatif. J'entends par là que le résultat de son calcul est imprécis et engendre des problèmes. Quand cela arrive t-il? Cela arrive quand on travaille dans un système de coordonnées élevées (beaucoup de chiffres avant la virgule) Du coup lors des calculs la précision après la virgule et "mangé" par la présence ces nombreux chiffres avant la virgule. C'est un problème qui a déjà été évoqué sur le forum. La seule astuce imparable et de rapprocher le dessin de l'origine 0,0,0 pour que les calculs aient une précision suffisante. Bien sur garder des points de référence pour ré-déplacer l'ensemble une fois son travail complétement achevé. -
Bonjour, Pas très précise la demande, comme évoqué par rebcao les solutions sont multiples (blocs, point3d...) ainsi que les importations dans Autocad. Quelle est la source (type de fichier) des coordonnées? Un exemple avec un fichier CSV sous la forme: Numéro du point ; X du point ; Y du point ; Z du point Ce qui suit te permettra l'import facilement (defun c:readCSV ( / input f_open l_read num_data x_data y_data z_data naw_pt) (setq input (getfiled "Select a CSV file" "" "csv" 2) f_open (open input "r") ) (while (setq l_read (read-line f_open)) (setq num_data (atoi (substr l_read 1 (vl-string-position 59 l_read))) l_read (substr l_read (+ 2 (vl-string-position 59 l_read))) x_data (atof (substr l_read 1 (vl-string-position 59 l_read))) l_read (substr l_read (+ 2 (vl-string-position 59 l_read))) y_data (atof (substr l_read 1 (vl-string-position 59 l_read))) l_read (substr l_read (+ 2 (vl-string-position 59 l_read))) z_data (atof (substr l_read 1 (vl-string-position 59 l_read))) new_pt (list x_data y_data z_data) ) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") (cons 8 "POINTS-3D") (cons 10 new_pt) '(210 0.0 0.0 1.0) '(50 . 0.0) ) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 8 "NUM-POINTS") (cons 10 new_pt) (cons 40 (getvar "TEXTSIZE")) (cons 1 (itoa num_data)) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(7 . "Standard") '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0) ) ) ) (close f_open) (prin1) ) Pour le tableau, j'avais publié sur un forum US ce qui suit (je le copie-colle tel quel): (vl-load-com) (defun c:points2cell ( / js AcDoc Space nw_style oldim oldlay ins_pt_cell h_t w_c lst_id-seg lst_pt n obj dxf_10 nb nw_obj ename_cell n_row n_column) (princ "\nSelect points.") (while (null (setq js (ssget '((0 . "POINT"))))) (princ "\nSelection empty, or is not a point!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Table-Points")) (vla-add (vla-get-layers AcDoc) "Table-Points") ) ) (cond ((null (tblsearch "STYLE" "Text-Cell")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Cell")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) (command "_.ddunits" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) ) ) (setq oldim (getvar "dimzin") oldlay (getvar "clayer") ) (setvar "dimzin" 0) (setvar "clayer" "Table-Points") (initget 9) (setq ins_pt_cell (getpoint "\nLeft-Up insert point of table: ")) (initget 6) (setq h_t (getdist ins_pt_cell (strcat "\nHigth text <" (rtos (getvar "textsize")) ">: "))) (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t)) (initget 7) (setq w_c (getdist ins_pt_cell "\nWidth of cells: ")) (setq lst_id-seg '() lst_pt '() nb 0 ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) dxf_10 (cdr (assoc 10 (entget obj))) lst_pt (cons dxf_10 lst_pt) nb (1+ nb) lst_id-seg (cons nb lst_id-seg) ) ) (mapcar '(lambda (p tx) (setq nw_obj (vla-addMtext Space (vlax-3d-point p) 0.0 tx ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 h_t 5 p "Text-Cell" "Table-Points" 0.0) ) ) lst_pt lst_id-seg ) (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 2 nb) 3 (+ h_t (* h_t 0.25)) w_c) (setq ename_cell (vlax-ename->vla-object (entlast)) n_row (1+ nb) n_column -1) (vla-SetCellValue ename_cell 0 0 (vlax-make-variant (strcat "Summary of " (itoa (sslength js)) " POINTS") 8 ) ) (vla-SetCellTextStyle ename_cell 0 0 "Text-Cell") (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell 0 0 5) (foreach n (mapcar'list (append lst_id-seg '("N°")) (append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordinates X")) (append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordinates Y")) ) (mapcar '(lambda (el) (vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column)) (if (or (eq (rtos 0.0) el) (eq (angtos 0.0) el)) (vlax-make-variant "_" 8) (vlax-make-variant el 8)) ) (vla-SetCellTextStyle ename_cell n_row n_column "Text-Cell") (vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5)) (if (eq n_row 1) (vla-SetCellAlignment ename_cell n_row n_column 5) (vla-SetCellAlignment ename_cell n_row n_column 6) ) ) n ) (setq n_row (1- n_row) n_column -1) ) (setvar "dimzin" oldim) (setvar "clayer" oldlay) (prin1) )
-
Comme dit (gile) la commande SCU (option 3p par exemple) répondrait à ta question. Néanmoins si tu désire avoir les réponses des coordonnées sans avoir à créer des SCU, alors il faut passer par des matrices de transformation. Par exemple ceci devrait fonctionner. (defun transpts (apt matrix / ) (list (+ (* (car (nth 0 matrix)) (car apt)) (* (car (nth 1 matrix)) (cadr apt)) (* (car (nth 2 matrix)) (caddr apt)) (cadddr (nth 0 matrix)) ) (+ (* (cadr (nth 0 matrix)) (car apt)) (* (cadr (nth 1 matrix)) (cadr apt)) (* (cadr (nth 2 matrix)) (caddr apt)) (cadddr (nth 1 matrix)) ) (+ (* (caddr (nth 0 matrix)) (car apt)) (* (caddr (nth 1 matrix)) (cadr apt)) (* (caddr (nth 2 matrix)) (caddr apt)) (cadddr (nth 2 matrix)) ) ) ) (defun v_matr (dpt alphax alphay alphaz echx echy echz / ) (list (list (* echx (cos alphaz) (cos alphay)) (- (sin alphaz)) (sin alphay) (car dpt) ) (list (sin alphaz) (* echy (cos alphaz) (cos alphax)) (- (sin alphax)) (cadr dpt) ) (list (- (sin alphay)) (sin alphax) (* echz (cos alphax) (cos alphay)) (caddr dpt) ) (list 0.0 0.0 0.0 1.0) ) ) (defun C:MY_REF ( / pt_base pt_ori pt_x pt) (initget 9) (setq pt_base (getpoint "\nPoint de reference?: ")) (initget 9) (setq pt_ori (getpoint pt_base "\nPoint d'orientation?: ")) (while (setq pt_x (getpoint "\nPoint voulu dans cette reference?: ")) (setq transform (v_matr (mapcar '- (trans pt_base 1 0)) 0.0 0.0 0.0 1.0 1.0 1.0) pt (transpts (trans pt_x 1 0) transform) transform (v_matr '(0.0 0.0 0.0) 0.0 0.0 (angle (trans pt_base 1 0) (trans pt_ori 1 0)) 1.0 1.0 1.0) pt (transpts pt transform) ) (princ (strcat "\nX=" (rtos (car pt)) " Y=" (rtos (cadr pt)) " Z=" (rtos (caddr pt)))) ) (prin1) )
-
[Résolu] Probl comment créer un bloc point altitude
bonuscad a répondu à un(e) sujet de jpeg dans AutoCAD 2013
Bon un peu tard mais on ne sait jamais... Cette solution imparfaite bien sur (le hic est qu'il va prendre l'altitude la plus proche du point, donc pas forcement correct) mais qui dans l'ensemble fera pas mal de boulot. Comme Didier décompose les Mtext en Texte avant d'utiliser la procédure lisp. (vl-load-com) (defun c:demo ( / js js1 js2 n ent obj len ori n1 obj1 n2 obj2 pt lst_pt js_text l nt dxf_ent z) (setq js (ssget "_X" '((0 . "LWPOLYLINE") (8 . "AS_nivellement")))) (setq js1 (ssadd) js2 (ssadd)) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ent) len (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) ori (angle (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) ) (if (equal len 0.6886771708 1E-08) (if (equal ori 1.26052358 1E-08) (ssadd ent js1) (ssadd ent js2) ) ) ) (cond ((and js1 js2) (repeat (setq n1 (sslength js1)) (setq obj1 (vlax-ename->vla-object (ssname js1 (setq n1 (1- n1))))) (repeat (setq n2 (sslength js2)) (setq obj2 (vlax-ename->vla-object (ssname js2 (setq n2 (1- n2)))) pt (vlax-invoke obj1 'intersectwith obj2 0) ) (if pt (if (> (length pt) 3) (repeat (/ (length pt) 3) (setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt)) ) (setq lst_pt (cons pt lst_pt)) ) ) ) ) ) ) (cond (lst_pt (repeat (setq n1 (sslength js1)) (entdel (ssname js1 (setq n1 (1- n1)))) ) (repeat (setq n2 (sslength js2)) (entdel (ssname js2 (setq n2 (1- n2)))) ) (repeat (setq n (length lst_pt)) (setq js_text (ssget "_C" (mapcar '- (car lst_pt) '(2.5 2.5 0.0)) (mapcar '+ (car lst_pt) '(2.5 2.5 0.0))'((0 . "TEXT") (8 . "AS_nivellement")))) (cond (js_text (setq l nil) (repeat (setq nt (sslength js_text)) (setq dxf_ent (entget (ssname js_text (setq nt (1- nt))))) (if (eq (type (read (cdr (assoc 1 dxf_ent)))) 'REAL) (setq l (cons (list (distance (car lst_pt) (cdr (assoc 10 dxf_ent))) (read (cdr (assoc 1 dxf_ent)))) l)) ) ) (if l (setq z (cadr (assoc (apply 'min (mapcar 'car l)) l))) (setq z 0.0) ) ) (T (setq z 0.0)) ) (entmake (list '(0 . "POINT") '(8 . "AS_nivellement") (cons 10 (list (caar lst_pt) (cadar lst_pt) z)) '(210 0.0 0.0 1.0) ) ) (setq lst_pt (cdr lst_pt) js_text nil l nil) ) ) ) (prin1) ) -
Tu a posté dans Autocad 2016, donc je présume que tu as une version pleine. Alors l'instruction lisp (layoutlist) en ligne de commande devrait t'aider...
-
Le moteur de recherche Autodesk francophone est de nouveau en ligne
bonuscad a répondu à un sujet dans CAO, généralités
Pour information, dans mon entreprise c'est bloqué. http://pix.toile-libre.org/upload/thumb/1512377289.png -
Alors, précision importante que j'ai oublié de dire: Cela se joue avec le pavé numérique 2 4 8 6 pour simuler le déplacement avec les flèches directionnelles. Sur un portable (sans pavé) c'est plus fastidieux, mais les touches peuvent être reprogrammées. Le but du jeu: ammener des chiffres identiques bord à bord pour les fusionner et les additionner jusqu'à obtenir le nombre 2048. Attention cela peut être addictif :D
-
Bonjour, Je pense que tout le monde connait 2048 Pour le fun, j'ai tenté de le réécrire en lisp. Par rapport à l'original il présente certainement un comportement un peu différent; j'ai développé mon propre algorithme, mais il est jouable. Il y a certainement mieux, donc le challenge est lancé, pour ma part j'avais pensé que ce serait assez simple mais je me suis trompé, je suis passé par un phase de test assez fastidieuse pour la mise au point. Vos avis? Vos propositions?! ;; C:GAME2048 ;; Un clone en AutoLisp inspiré de https://gabrielecirulli.github.io/2048/ ;; par Bruno VALSECCHI Decembre 2017 ;; ;; Joindre les nombres de même valeur jusqu'à obtenir la tuile 2048! ;; ;; Utiliser les touches 2 4 6 8 du pavé numérique pour déplacer les tuiles vers le bas, gauche, droite, haut ;; (defun randomize (v1 v2 / ) (if (not v_sd) (setq v_sd (getvar "DATE")) ) (setq v_sd (rem (+ (* 25173 v_sd) 13849) 65536)) (+ (* (/ v_sd 65536) (- (max v1 v2) (min v1 v2))) (min v1 v2)) ) (defun vl-position-multi (el l / n l_id l_n) (setq n 0 l_id (mapcar '(lambda (x) (equal x el)) l) ) (repeat (length l_id) (if (car l_id) (setq l_n (cons n l_n))) (setq n (1+ n) l_id (cdr l_id)) ) (reverse l_n) ) (defun draw_map (statut_map / lm_col lt_col tmp lx ly dxf_m dxf_t x y) (setq lm_col '((0 . 252) (2 . 255) (4 . 53) (8 . 31) (16 . 30) (32 . 20) (64 . 22) (128 . 42) (256 . 52) (512 . 40) (1024 . 32) (2048 . 2))) (setq lt_col '((0 . 252) (2 . 250) (4 . 250) (8 . 255) (16 . 255) (32 . 255) (64 . 255) (128 . 255) (256 . 255) (512 . 255) (1024 . 255) (2048 . 1))) (setq tmp map) (setq lx (mapcar 'car tmp) ly (mapcar 'cdr tmp)) (foreach dxf_mask lst_mask (setq dxf_m (entget (cdr dxf_mask))) (mapcar '(lambda (xi yi / x y) (setq x xi y yi) (entmod (subst (cons 10 (list (cdr x) (car x) 0)) (assoc 10 dxf_m) dxf_m ) ) (entmod (subst (cons 11 (list (1+ (cdr x)) (car x) 0)) (assoc 11 dxf_m) dxf_m ) ) (entmod (subst (cons 12 (list (cdr x) (1+ (car x)) 0)) (assoc 12 dxf_m) dxf_m ) ) (entmod (subst (cons 13 (list (1+ (cdr x)) (1+ (car x)) 0)) (assoc 13 dxf_m) dxf_m ) ) (entmod (subst (cons 62 (cdr (assoc y lm_col))) (assoc 62 dxf_m) dxf_m ) ) ) (list (car lx)) (list (car ly)) ) (setq lx (cdr lx) ly (cdr ly)) ) (setq lx (mapcar 'car tmp) ly (mapcar 'cdr tmp)) (foreach dxf_text lst_text (setq dxf_t (entget (cdr dxf_text))) (mapcar '(lambda (x y / x y) (entmod (subst (cons 11 (list (+ 0.5 (cdr x)) (+ 0.5 (car x)) 0)) (assoc 11 dxf_t) dxf_t ) ) (entmod (subst (cons 1 (itoa y)) (assoc 1 dxf_t) (subst (cons 62 (cdr (assoc y lt_col))) (assoc 62 dxf_t) dxf_t ) ) ) ) (list (car lx)) (list (car ly)) ) (setq lx (cdr lx) ly (cdr ly)) ) (command "_.TEXTTOFRONT" "_Text") ) (defun evaluate_push (l count / l) (setq l (reverse (vl-remove 0 l))) (if (cdr l) (cond ((and (eq (car l) (cadr l)) (<= (+ (car l) (cadr l)) count)) (evaluate_push (reverse (cons (+ (car l) (cadr l)) (cddr l))) count) ) (T (evaluate_push (reverse (cdr l)) count) (setq nwl (cons (car l) nwl)) ) ) (setq nwl (cons (car l) nwl)) ) (reverse (if (car nwl) nwl '(0))) ) (defun push (k / lst tmp nwl) (setq map-n map) (cond ((eq k 50) (setq lst '("C-U3" "C-U2" "C-U1" "C-U0")) ) ((eq k 52) (setq lst '("R-R0" "R-R1" "R-R2" "R-R3")) ) ((eq k 54) (setq lst '("R-L3" "R-L2" "R-L1" "R-L0")) ) ((eq k 56) (setq lst '("C-D0" "C-D1" "C-D2" "C-D3")) ) ) (foreach n lst (setq tmp (mapcar 'cdr (mapcar '(lambda (x) (assoc x map)) (eval (read n)))) nwl nil) (setq nwl (evaluate_push tmp (* (if (member (apply 'max tmp) (cdr (member (apply 'max tmp) tmp))) 2 1) (apply 'max tmp)))) (if (not (eq (length (vl-remove 0 nwl)) 4)) (progn (repeat (- (length tmp) (length (setq nwl (vl-remove 0 nwl)))) (setq nwl (cons 0 nwl)) ) nwl ) nwl ) (setq tmp (mapcar '(lambda (x) (assoc x map)) (eval (read n)))) (foreach n (mapcar '(lambda (x y) (cons x y)) (mapcar 'car (mapcar '(lambda (x) (assoc x map)) (eval (read n)))) nwl) (setq map (subst n (assoc (car n) map) map)) ) ) ) (defun c:Game2048 ( / v_sd mat_game map lst_mask lst_text nw_pos key before after win loose) (foreach n '("R-L0" "R-L1" "R-L2" "R-L3" "R-R0" "R-R1" "R-R2" "R-R3") (set (read n) nil)) (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3") (set (read n) nil)) (setq mat_game '( (3 . 0) (3 . 1) (3 . 2) (3 . 3) (2 . 0) (2 . 1) (2 . 2) (2 . 3) (1 . 0) (1 . 1) (1 . 2) (1 . 3) (0 . 0) (0 . 1) (0 . 2) (0 . 3) ) ) (mapcar '(lambda (x y) (set (read (strcat "R-R" (itoa y))) (reverse x) ) ) (mapcar '(lambda (x y) (foreach n x (set (read (strcat "R-L" (itoa y))) (cons (nth n mat_game) (eval (read (strcat "R-L" (itoa y)))) ) ) ) ) (mapcar '(lambda (x) (vl-position-multi x (mapcar 'car mat_game)) ) '(0 1 2 3) ) '(0 1 2 3) ) '(0 1 2 3) ) (mapcar '(lambda (x y) (set (read (strcat "C-D" (itoa y))) (reverse x) ) ) (mapcar '(lambda (x y) (foreach n x (set (read (strcat "C-U" (itoa y))) (cons (nth n mat_game) (eval (read (strcat "C-U" (itoa y)))) ) ) ) ) (mapcar '(lambda (x) (vl-position-multi x (mapcar 'cdr mat_game)) ) '(0 1 2 3) ) '(0 1 2 3) ) '(0 1 2 3) ) (setq map (mapcar '(lambda (n / ) (cons n 0)) mat_game)) (entmake '( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "2048") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 0.5) (3 . "arial.ttf") (4 . "") ) ) (setvar "TEXTSTYLE" "2048") (setvar "CMDECHO" 0) (command "_.zoom" "_window" "_none" '(0 0) "_none" '(4 4)) (foreach n map (entmake (list '(0 . "SOLID") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "0") '(62 . 252) '(100 . "AcDbTrace") (cons 10 (list (cdar n) (caar n) 0)) (cons 11 (list (1+ (cdar n)) (caar n) 0)) (cons 12 (list (cdar n) (1+ (caar n)) 0)) (cons 13 (list (1+ (cdar n)) (1+ (caar n)) 0)) '(39 . 0.0) '(210 0.0 0.0 1.0) ) ) (setq lst_mask (cons (assoc -1 (entget (entlast))) lst_mask)) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "0") '(62 . 252) '(100 . "AcDbText") (cons 10 (list (+ (cdar n) 0.19423602) (+ (caar n) 0.25) 0)) '(40 . 0.5) '(1 . "0") '(50 . 0.0) '(41 . 0.65) '(51 . 0.0) '(7 . "2048") '(71 . 0) '(72 . 1) (cons 11 (list (+ (cdar n) 0.5) (+ (caar n) 0.5) 0)) '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 2) ) ) (setq lst_text (cons (assoc -1 (entget (entlast))) lst_text)) ) (setq nw_pos (cons (cons (read (rtos (randomize 0 3) 2 0)) (read (rtos (randomize 0 3) 2 0)) ) (* 2 (read (rtos (randomize 1 2) 2 0))) ) ) (if (or (zerop (cdr (assoc (car nw_pos) map))) (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos)) ) (setq map (subst (cons (car nw_pos) (+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))) (assoc (car nw_pos) map) map)) ) (draw_map map) (print) (while (and (setq key (grread T 4 0)) (not loose)) (if (member (cadr key) '(50 52 54 56)) (progn (setq before (mapcar 'cdr map)) (push (cadr key)) (if (member 2048 (mapcar 'cdr map)) (progn (setq win T) (alert "GAGNE"))) (setq after (mapcar 'cdr map)) (cond ((not (equal before after)) (while (not (zerop (cdr (assoc (car (setq nw_pos (cons (cons (read (rtos (randomize 0 3) 2 0)) (read (rtos (randomize 0 3) 2 0)) ) (* 2 (read (rtos (randomize 1 2) 2 0))) ) ) ) map ) ) ) ) ) (if (or (zerop (cdr (assoc (car nw_pos) map))) (eq (cdr (assoc (car nw_pos) map)) (cdr nw_pos)) ) (setq map (subst (cons (car nw_pos) (+ (cdr nw_pos) (cdr (assoc (car nw_pos) map)))) (assoc (car nw_pos) map) map)) ) (draw_map map) ) (T (if (not (member 0 (mapcar 'cdr map))) (setq loose T))) ) ) ) ) (if (not win) (alert "PERDU")) (command "_.ERASE" "_All" "") (setvar "TEXTSTYLE" "Standard") (setvar "CMDECHO" 1) (foreach n '("R-L0" "R-L1" "R-L2" "R-L3" "R-R0" "R-R1" "R-R2" "R-R3") (set (read n) nil)) (foreach n '("C-U0" "C-U1" "C-U2" "C-U3" "C-D0" "C-D1" "C-D2" "C-D3") (set (read n) nil)) (prin1) ) Bien sur, à tester/utiliser dans un dessin vierge (hors session de travail, des bugs bloquants restent possibles)
-
Creation presentations en automatique
bonuscad a répondu à un(e) sujet de patrick.albinet dans AutoCAD Civil
Bonjour, Tu peux essayer avec ça; fait depuis ton dessin exemple (l'ideal est de supprimer la présentation (1) avant utilisation du lisp. (defun c:test ( / js n ent dxf_ent pt_ins rot num adoc lay i j) (setq js (ssget "_X" '((0 . "INSERT") (67 . 0) (410 . "Model") (8 . "EE_07_ENCARTAGE A3 VUE EN PLAN") (66 . 1) (2 . "A$C28036E38")))) (cond (js (setvar "ATTDIA" 0) (setvar "ATTREQ" 0) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n)))) (setq dxf_ent (entget ent)) (setq pt_ins (cdr (assoc 10 dxf_ent))) (setq rot (- (cdr (assoc 50 dxf_ent)) 1.186823891356802)) (setq num (cdr (assoc 1 (entget (entnext (cdar dxf_ent)))))) (command "_.-LAYOUT" "_New" num) (command "_.-LAYOUT" "_Set" num) (command "_.ERASE" (ssget "_X" (list '(0 . "VIEWPORT") '(67 . 1) (cons 410 num) (cons 8 (getvar "CLAYER")))) "") (setvar "CLAYER" "EE_07_ENCARTAGE A3 VUE EN PLAN") (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (setq lay (vla-get-ActiveLayout adoc)) (vla-Put-Configname lay "DWG To PDF.pc3") (vla-put-CanonicalMediaName lay "ISO_full_bleed_A3_(420.00_x_297.00_MM)") (vla-SetCustomScale lay (vlax-make-variant 1.0) (vlax-make-variant 1.0)) (setq i (vlax-make-safearray vlax-vbDouble '(0 . 1))) (vlax-safearray-put-element i 0 0.0) (vlax-safearray-put-element i 1 0.0) (setq j (vlax-make-safearray vlax-vbDouble '(0 . 1))) (vlax-safearray-put-element j 0 410.0) (vlax-safearray-put-element j 1 287.0) (vla-SetWindowToPlot lay i j) (vlax-put lay 'PlotOrigin '(4.20624 4.20624)) (vla-put-PaperUnits lay 1) (vla-put-PlotHidden lay 0) (vla-put-PlotRotation lay 0) (vla-put-PlotType lay 4) (vla-put-PlotViewportBorders lay 0) (vla-put-PlotViewportsFirst lay 1) (vla-put-PlotWithLineweights lay 1) (vla-put-PlotWithPlotStyles lay 1) (vla-put-ScaleLineweights lay 0) (vla-put-ShowPlotStyles lay 0) (vla-put-StandardScale lay 16) (vla-put-StyleSheet lay "") (vla-put-UseStandardScale lay 1) (vla-put-CenterPlot lay 1) (command "_.MVIEW" "_none" "0.0,20.2759" "_none" "@410,266.724") (command "_.ZOOM" "_extent") (command "_MSPACE") (command "_UCS" "3" "_none" pt_ins "_none" (polar pt_ins (+ (* 0.5 pi) rot) 1.0) "_none" (polar pt_ins (+ rot pi) 1.0)) (command "_.PLAN" "_current") (command "_zoom" "_left" "_none" "0,0" "250") (command "_.PSPACE") (setvar "CLAYER" "EE_03_CARTOUCHE") (command "_.MVIEW" "_none" "0.0,0,0" "_none" "@138.2782,20.2759") (command "_.-INSERT" "CARTOUCHE_BANDE_A4" "_none" "410.0,0" "1" "0") ) (setvar "ATTDIA" 1) (setvar "ATTREQ" 1) ) ) ) Ce qui fait que le programme peut faire qu'Autocad affiche qu'il ne répond pas.... Mais laisse faire quand même, il fait le boulot, il fini par rendre la main.
