Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/03/2022 in all areas

  1. I'm pleased that you find this old application useful; though, you may find my more recently developed Batch Attribute Editor application a more powerful attribute editing utility, given that it offers the ability to edit attribute values across multiple blocks of varying block names. You may argue that the use of a Script file to perform the attribute modification across multiple drawings is inherently less powerful than the ObjectDBX interface leveraged by this older program, however, ObjectDBX has too many bugs where attribute modification is concerned and so I have since abandoned it's use for this purpose. Nevertheless, to allow the user to specify tags containing slashes (and other such characters), change the following lines: Line 1265 from: ( (or (not (snvalid str)) (vl-string-position 32 str)) To: ( (vl-string-position 32 str) Line 1457 from: ( (or (not (snvalid str)) (vl-string-position 32 str)) To: ( (vl-string-position 32 str) Line 1579 from: ( (or (not (snvalid new_tag)) (vl-string-position 32 new_tag)) To: ( (vl-string-position 32 new_tag) Line 2485 from: ( (or (not (snvalid tag_str)) (vl-string-position 32 tag_str)) To: ( (vl-string-position 32 tag_str)
    2 points
  2. ; 2048 game by autolisp - 2022.05.02 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/ ; command : ; - 2048 (graphic mode) ; - 2048t (command prompt text only mode) ; key : W = up, A = left, S = down, D = right, P = end game ; key2 : 8 = up, 4 = left, 5 = down, 6 = right (for numpad with numlock on), P = end game ; this lisp use your dwg's 15 x 8 space. so you have to run this in new drawing not working dwg. (vl-load-com) (defun c:2048t ( / playlist start newnum *error* graphicmode starttime timer score ) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'cmdecho 1) (princ) ) (setq timer 0) (setq starttime (getvar "date")) (setq score 0) (setq playlist (list (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) )) (setq graphicmode 0) (output2048txt playlist) (setq start (getstring "\n 2048 Start (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (exit) ) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun c:2048 ( / playlist start newnum *error* graphicmode starttime timer score) (setvar 'cmdecho 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'cmdecho 1) (princ) ) (setq timer 0) (setq starttime (getvar "date")) (setq score 0) (setq basept (getpoint "\n pick point for 2048 ")) (setq playlist (list (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) (list 0 0 0 0) )) (setq graphicmode 1) (output2048 playlist basept) (output2048txt playlist) (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq zoompt (list (+ baseptx 15) (+ basepty 8))) (command "_.zoom" "w" basept zoompt) (setq start (getstring "\n 2048 Start (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (exit) ) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun play ( playlist basept / movement input newplaylist rowlen indexr row collen indexc nonezerolist cell calcindex a b c d nonezerolist2 nowtime ) (setq playlist (makenewnum playlist)) (if (= graphicmode 1) (output2048 playlist basept) ) (output2048txt playlist) (setq input (grread2048)) (cond ((= input "W") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) ;(princ "\n input W") (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "A") ;(princ "\n input A") (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "S") ;(princ "\n input S") (setq playlist (list (list (nth 0 (nth 3 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 0 playlist))) (list (nth 1 (nth 3 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 0 playlist))) (list (nth 2 (nth 3 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 0 playlist))) (list (nth 3 (nth 3 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 0 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 3 (nth 1 playlist)) (nth 3 (nth 2 playlist)) (nth 3 (nth 3 playlist))) (list (nth 2 (nth 0 playlist)) (nth 2 (nth 1 playlist)) (nth 2 (nth 2 playlist)) (nth 2 (nth 3 playlist))) (list (nth 1 (nth 0 playlist)) (nth 1 (nth 1 playlist)) (nth 1 (nth 2 playlist)) (nth 1 (nth 3 playlist))) (list (nth 0 (nth 0 playlist)) (nth 0 (nth 1 playlist)) (nth 0 (nth 2 playlist)) (nth 0 (nth 3 playlist))))) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (play playlist basept) ) ((= input "D") ;(princ "\n input D") (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (setq newplaylist '()) (setq rowlen (length playlist)) (setq indexr 0) (repeat rowlen (setq row (nth indexr playlist)) (setq collen (length row)) (setq indexc 0) (setq nonezerolist '()) (repeat collen (setq cell (nth indexc row)) (if (/= cell 0) (setq nonezerolist (cons cell nonezerolist)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist)) (setq nonezerolist (cons 0 nonezerolist)) ) (setq calcindex 0) (setq nonezerolist (reverse nonezerolist)) (setq a (nth 0 nonezerolist)) (setq b (nth 1 nonezerolist)) (setq c (nth 2 nonezerolist)) (setq d (nth 3 nonezerolist)) (if (and (= a b) (/= a 0) (/= b 0)) (progn (setq a (+ a b)) (setq b c) (setq c d) (setq d 0) (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq b (+ b c)) (setq c 0) );end of progn );end of if );end of progn (progn (if (and (= b c) (/= b 0) (/= c 0)) (progn (setq a a) (setq b (+ b c)) (setq c d) (setq d 0) ) (progn (if (and (= c d) (/= c 0) (/= d 0)) (progn (setq c (+ c d)) (setq d 0) ) ) );end of progn );end of if );end of progn );end of if (setq nonezerolist (list a b c d)) (setq nonezerolist2 '()) (setq indexc 0) (repeat collen (setq cell (nth indexc nonezerolist)) (if (/= cell 0) (setq nonezerolist2 (cons cell nonezerolist2)) ) (setq indexc (+ indexc 1)) ) (repeat (- collen (length nonezerolist2)) (setq nonezerolist2 (cons 0 nonezerolist2)) ) (setq newplaylist (cons (reverse nonezerolist2) newplaylist)) (setq indexr (+ indexr 1)) );end of repeat (setq playlist (reverse newplaylist)) (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (princ " / score - ") (princ score) (setq playlist (list (list (nth 3 (nth 0 playlist)) (nth 2 (nth 0 playlist)) (nth 1 (nth 0 playlist)) (nth 0 (nth 0 playlist))) (list (nth 3 (nth 1 playlist)) (nth 2 (nth 1 playlist)) (nth 1 (nth 1 playlist)) (nth 0 (nth 1 playlist))) (list (nth 3 (nth 2 playlist)) (nth 2 (nth 2 playlist)) (nth 1 (nth 2 playlist)) (nth 0 (nth 2 playlist))) (list (nth 3 (nth 3 playlist)) (nth 2 (nth 3 playlist)) (nth 1 (nth 3 playlist)) (nth 0 (nth 3 playlist))))) (play playlist basept) ) ((= input "P") ;(princ "\n input P") (princ "\n your time lap is ") (princ timer) (princ "\n your score is ") (princ score) (if (= graphicmode 1) (progn (setq delyn (getstring "\n you want to delete game board? (Press Anykey - Yes / N - No)")) (if (/= (strcase delyn) "N") (progn (if (/= ss2048 nil) (command "_.Erase" ss2048 "") ) (if (/= ss22048 nil) (command "_.Erase" ss22048 "") ) (if (/= ss32048 nil) (command "_.Erase" ss32048 "") ) (if (/= ss42048 nil) (command "_.Erase" ss42048 "") ) );end of progn );end of if );end of progn );end of if ); end of "p" );end of cond ) (defun output2048txt ( lst / adjust lstlen indexr row rowlen indexc cell celllen delta ) (setq adjust 10) (setq lstlen (length lst)) (setq indexr 0) (setq score 0) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (setq score (+ score cellnum)) (setq cell (vl-princ-to-string cellnum)) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat (princ "\n Waiting User Input - ") );end of output2048txt (defun output2048 ( lst basept / adjust lstlen indexr row rowlen indexc cell celllen delta basept baseptx basepty ptlist ptrow ptcell ptcellx ptcelly cellnum ) (setq adjust 10) (setq lstlen (length lst)) (setq indexr 0) (if (/= ss2048 nil) (command "_.Erase" ss2048 "") ) (setq ss2048 (ssadd)) (if (/= ss22048 nil) (command "_.Erase" ss22048 "") ) (setq ss22048 (ssadd)) (if (/= ss32048 nil) (command "_.Erase" ss32048 "") ) (setq ss32048 (ssadd)) (if (/= ss42048 nil) (command "_.Erase" ss42048 "") ) (setq ss42048 (ssadd)) (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq ptlist (list (list (list (+ baseptx 0) (+ basepty 6)) (list (+ baseptx 2) (+ basepty 6)) (list (+ baseptx 4) (+ basepty 6)) (list (+ baseptx 6) (+ basepty 6))) (list (list (+ baseptx 0) (+ basepty 4)) (list (+ baseptx 2) (+ basepty 4)) (list (+ baseptx 4) (+ basepty 4)) (list (+ baseptx 6) (+ basepty 4))) (list (list (+ baseptx 0) (+ basepty 2)) (list (+ baseptx 2) (+ basepty 2)) (list (+ baseptx 4) (+ basepty 2)) (list (+ baseptx 6) (+ basepty 2))) (list (list (+ baseptx 0) (+ basepty 0)) (list (+ baseptx 2) (+ basepty 0)) (list (+ baseptx 4) (+ basepty 0)) (list (+ baseptx 6) (+ basepty 0))) )) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq ptrow (nth indexr ptlist)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (setq cell (vl-princ-to-string cellnum)) (setq ptcell (nth indexc ptrow)) (setq ptcellx (car ptcell)) (setq ptcelly (cadr ptcell)) (if (= cell nil) (setq cell 0)) (setq celllen (strlen cell)) (setq delta (- adjust celllen)) (repeat delta (setq cell (strcat cell " ")) ) (cond ((= cellnum 0) (setq colorcode 7) (setq cellnum " ")) ((= cellnum 2) (setq colorcode 81)) ((= cellnum 4) (setq colorcode 71)) ((= cellnum 8) (setq colorcode 61)) ((= cellnum 16) (setq colorcode 51)) ((= cellnum 32) (setq colorcode 41)) ((= cellnum 64) (setq colorcode 31)) ((= cellnum 128) (setq colorcode 21)) ((= cellnum 256) (setq colorcode 11)) ((= cellnum 512) (setq colorcode 10)) ((= cellnum 1024) (setq colorcode 12)) ((= cellnum 2048) (setq colorcode 14)) ((> cellnum 2048) (setq colorcode 6)) );end of cond (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 colorcode) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (vl-princ-to-string cellnum)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ ptcellx 1) (+ ptcelly 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) ss2048) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 colorcode) (cons 67 0) (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.1) (cons 38 0) (cons 39 0) (cons 10 (list (+ ptcellx 0.05) (+ ptcelly 0.05))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 1.95) (+ ptcelly 0.05))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 1.95) (+ ptcelly 1.95))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ ptcellx 0.05) (+ ptcelly 1.95))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) ss22048) (if (= timer nil) (setq timer 0)) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (strcat "Timer : " (rtos timer 2 2) " sec")) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 0) (cons 10 (list (+ baseptx 9) (+ basepty 6) 0)) (cons 100 "AcDbText") (cons 73 0))) (ssadd (entlast) ss32048) (if (= score nil) (setq score 0)) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 0.5) (cons 1 (strcat "Score : " (rtos score 2 0) )) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 0) (cons 10 (list (+ baseptx 9) (+ basepty 4) 0)) (cons 100 "AcDbText") (cons 73 0))) (ssadd (entlast) ss42048) ;(princ cell) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat ;(princ "\n Waiting User Input - ") );end of output2048 (defun makenewnum ( lst / rowlen indexr zerolist row collen indexc cell remainzero newnum newspace replacerow replacecol newrowlist ) (setq rowlen (length lst)) (setq indexr 0) (setq zerolist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (repeat collen (setq cell (nth indexc row)) (if (= cell 0) (setq zerolist (cons (list indexr indexc) zerolist)) ) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) );end of repeat ;(princ zerolist) (setq remainzero (length zerolist)) (if (= remainzero 0) (progn (princ "\n There's no space for new number") (princ "\n Game Over ") (exit) ) (progn (setq newnum (* (LM:randrange 1 2) 2)) (setq newspace (nth (- (LM:randrange 1 remainzero) 1) zerolist)) (setq replacerow (car newspace)) (setq replacecol (cadr newspace)) (setq indexr 0) (setq newlist '()) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (setq indexc 0) (setq newrowlist '()) (repeat collen (if (and (= indexc replacecol) (= indexr replacerow)) (progn (setq cell newnum) (setq newrowlist (cons cell newrowlist))) (progn (setq cell (nth indexc row)) (setq newrowlist (cons cell newrowlist))) ) (setq indexc (+ indexc 1)) ); end of repeat (setq newrowlist (reverse newrowlist)) (setq newlist (cons newrowlist newlist)) (setq indexr (+ indexr 1)) ); end of repeat ); end of progn );end of if (setq newlist (reverse newlist)) newlist );end of makenewnum ; by Kent1Cooper, https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-arrow-keys-sending-input-without-enter-and-returning-to/m-p/5371933/highlight/true#M327188 (defun grread2048 (/ done) (setq done nil) (while (and (not done) (setq opt (grread T 12 0))) (cond ((or (equal opt '(2 87)) (equal opt '(2 119)) (equal opt '(2 56))) ; input W (setq done T) (princ "\ Input Up (W)") (setq movement "W") ) ((or (equal opt '(2 65)) (equal opt '(2 97)) (equal opt '(2 52))) ; input A (setq done T) (princ "\ Input Left (A)") (setq movement "A") ) ((or (equal opt '(2 83)) (equal opt '(2 115)) (equal opt '(2 53))) ; input S (setq done T) (princ "\ Input Down (S)") (setq movement "S") ) ((or (equal opt '(2 68)) (equal opt '(2 100)) (equal opt '(2 54))) ; input D (setq done T) (princ "\ Input Right (D)") (setq movement "D") ) ((or (equal opt '(2 80)) (equal opt '(2 112))) ; input P (setq done T) (princ "\ Input End (P)") (setq movement "P") ) ); cond ); while movement );end of defun ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) ;; Random in Range - Lee Mac ;; Returns a pseudo-random integral number in a given range (inclusive) (defun LM:randrange ( a b ) (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b)))))) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) yes this is 2048 game for fun ( https://en.wikipedia.org/wiki/2048_(video_game) ) this is my grread practice code. command : - 2048 (graphic mode - use polyline and text) - 2048t (command prompt text only mode) Key : W = up , A = left , S = down, D = right, P = end game Key2 : 8 = up, 4 = left, 5 = down, 6 = right (for numpad with numlock on), P = end game If you can no longer generate numbers, it will be game over (but there seems to be some error haha) ------------------------------------------------------------------------ At first, I was going to practice grread simply, but it seems that I studied the algorithm of moving and adding in 4 directions more and more. Create a function for one direction, rotate the 4x4 matrix in 3 directions, apply it and back again. If it was implemented universally in this process, it would have been possible to freely create 5x5, 10x10, etc. not only 4x4, but it was difficult so I hard coding that. So it only works for 4x4 sadly
    1 point
  3. When I woke up, I realized that what I couldn't solve yesterday was a simple problem, so today I tried to make it. This code is what I needed in the 2048 code = Rotate or Flip any size of matrix. not only 4x4 I think, since this is a common function, there is a code that was created by others. but I couldn't find an appropriate keyword because my english was not good. - In the case of Flip, it is more concise to just use (reverse columnlist) or (reverse rowlist), but I wanted to make it according to the structure used. ; Rotate or Mirror a matrix - 2022.05.03 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/?do=findComment&comment=594432 ; how to use = (ex:rotatematrix list direction) ; list = matrix to rotate, list in list format like ((a b c d) (e f g h) (i j k l) (m n o p)) ; direction = ; "0", "90", "180", "270" - Enter the angle to rotate in string format ; "HFLIP", "VFLIP" - Horizontal or Vertical Flip ; ; There is a function to check if it is a matrix. ; ; Test Command ; 1. rotatetest - 4x5 matrix test ; 2. returntest - run twice to get back to original matrix ; 3. 50x50test - 50x50 matrix test (vl-load-com) (defun c:rotatetest ( / inputlist outputlist ) (setq inputlist (list (list "1a" "1b" "1c" "1d" "1e") (list "2a" "2b" "2c" "2d" "2e") (list "3a" "3b" "3c" "3d" "3e") (list "4a" "4b" "4c" "4d" "4e"))) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix inputlist "0")) (princ "\n Output List - Rotated 0 deg (nothing happened) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "90")) (princ "\n Output List - Rotated 90 deg (Leftside -> Downside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "180")) (princ "\n Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "270")) (princ "\n Output List - Rotated 270 deg (leftside -> upside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "HFLIP")) (princ "\n Output List - Horizontal Flip (Mirror the Columns) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "VFLIP")) (princ "\n Output List - Vertical Flip (Mirrir ther Rows) - ") (princ outputlist) (princ) );end of defun (defun c:returntest ( / inputlist outputlist ) (setq inputlist (list (list "1a" "1b" "1c" "1d" "1e") (list "2a" "2b" "2c" "2d" "2e") (list "3a" "3b" "3c" "3d" "3e") (list "4a" "4b" "4c" "4d" "4e"))) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "90") "270")) (princ "\n Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "270") "90")) (princ "\n Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "180") "180")) (princ "\n Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "HFLIP") "HFLIP")) (princ "\n Output List - Horizontal Flip -> Horizontal Flip - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "VFLIP") "VFLIP")) (princ "\n Output List - Vertical Flip -> Vertical Flip - ") (princ outputlist) (princ) );end of defun (defun c:50x50test ( / inputlist outputlist index1 index2 testcell testrow ) (setq index1 1) (setq inputlist '()) (repeat 50 (setq testrow '()) (setq index2 1) (repeat 50 (setq testcell (strcat (vl-princ-to-string index1) "-" (vl-princ-to-string index2))) (setq testrow (cons testcell testrow)) (setq index2 (+ index2 1)) );end of repeat (setq inputlist (cons (reverse testrow) inputlist)) (setq index1 (+ index1 1)) );end of repeat (setq inputlist (reverse inputlist)) (princ "\n Input List - ") (princ inputlist) (setq outputlist (ex:rotatematrix inputlist "0")) (princ "\n Output List - Rotated 0 deg (Not Rotated) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "90")) (princ "\n Output List - Rotated 90 deg (Leftside -> Downside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "180")) (princ "\n Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "270")) (princ "\n Output List - Rotated 270 deg (leftside -> upside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "HFLIP")) (princ "\n Output List - Horizontal Flip (Mirror the Columns) - ") (princ outputlist) (setq outputlist (ex:rotatematrix inputlist "VFLIP")) (princ "\n Output List - Vertical Flip (Mirrir ther Rows) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "90") "270")) (princ "\n Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "270") "90")) (princ "\n Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "180") "180")) (princ "\n Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "HFLIP") "HFLIP")) (princ "\n Output List - Horizontal Flip -> Horizontal Flip - ") (princ outputlist) (setq outputlist (ex:rotatematrix (ex:rotatematrix inputlist "VFLIP") "VFLIP")) (princ "\n Output List - Vertical Flip -> Vertical Flip - ") (princ outputlist) (princ) );end of defun (defun ex:rotatematrix (lst deg / rowlen oldcollen indexr checkflag row collen indexc rowlist cell ) ; check matrix (setq rowlen (length lst)) (setq oldcollen (length (nth 0 lst))) (setq indexr 0) (setq checkflag 0) (repeat rowlen (setq row (nth indexr lst)) (setq collen (length row)) (if (/= collen oldcollen) (setq checkflag 1) ) (setq oldcollen collen) (setq indexr (+ indexr 1)) );end of repeat (if (/= checkflag 1) (progn (cond ((= deg "90") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth (- (- collen 1) indexr) (nth indexc lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case1 90 ((= deg "180") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth (- (- collen 1) indexc) (nth (- (- rowlen 1) indexr) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case2 180 ((= deg "270") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth indexr (nth (- (- rowlen 1) indexc) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case3 270 ((= deg "HFLIP") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth (- (- collen 1) indexc) (nth indexr lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case4 horizontal flip ((= deg "VFLIP") (setq rowlen (length lst)) (setq collen (length (nth 0 lst))) (setq indexr 0) (setq outputlist '()) (repeat rowlen (setq indexc 0) (setq rowlist '()) (repeat collen (setq cell (nth indexc (nth (- (- rowlen 1) indexr) lst))) (setq rowlist (cons cell rowlist)) (setq indexc (+ indexc 1)) );end of repeat (setq indexr (+ indexr 1)) (setq outputlist (cons (reverse rowlist) outputlist)) );end of repeat (setq outputlist (reverse outputlist)) );end of cond case2 180 ((= deg "0") (setq outputlist lst) );end of cond case2 180 );end of cond outputlist );end of progn (progn (princ "\n It's not a Matrix - The number of columns in Row ") (princ indexr) (princ " is different from the other Rows.") (exit) );end of progn );end of if );end of defun Command: ROTATEMATRIX Input List - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 0 deg (Not Rotated) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 90 deg (Leftside -> Downside) - ((1e 2e 3e 4e) (1d 2d 3d 4d) (1c 2c 3c 4c) (1b 2b 3b 4b) (1a 2a 3a 4a)) Output List - Rotated 180 deg (Leftside -> Rightside (not a flip)) - ((4e 4d 4c 4b 4a) (3e 3d 3c 3b 3a) (2e 2d 2c 2b 2a) (1e 1d 1c 1b 1a)) Output List - Rotated 270 deg (leftside -> upside) - ((4a 3a 2a 1a) (4b 3b 2b 1b) (4c 3c 2c 1c) (4d 3d 2d 1d) (4e 3e 2e 1e)) Output List - Horizontal Flip (Mirror the Columns) - ((1e 1d 1c 1b 1a) (2e 2d 2c 2b 2a) (3e 3d 3c 3b 3a) (4e 4d 4c 4b 4a)) Output List - Vertical Flip (Mirrir ther Rows) - ((4a 4b 4c 4d 4e) (3a 3b 3c 3d 3e) (2a 2b 2c 2d 2e) (1a 1b 1c 1d 1e)) Command: RETURNTEST Input List - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 90->270 deg (leftside -> downside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 270->90 deg (leftside -> upside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Rotated 180->180 deg (leftside -> rightside -> leftside) - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Horizontal Flip -> Horizontal Flip - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e)) Output List - Vertical Flip -> Vertical Flip - ((1a 1b 1c 1d 1e) (2a 2b 2c 2d 2e) (3a 3b 3c 3d 3e) (4a 4b 4c 4d 4e))
    1 point
  4. When a command is active like move or copy _previous (or _P) selects the previous selection. Your macro runs your lisp command QSPREVIOUS if there's no active command but does nothing if a command is active. The three macros I posted all work as expected whether a command is active or not.
    1 point
  5. Check GRID & SNAP turn off.
    1 point
  6. This is a very interesting and creative example.
    1 point
  7. The following should work on multiple lines anywhere in 3D. (defun c:test (/ p ss n i en ed e1 e2 ea eb end u d ee) ;; L. Minardi 5/2/2022 (setq p (getpoint "\nSpecify projection point.")) (setq ss (ssget '((0 . "line")))) (setq n (sslength ss)) (setq i 0) (while (< i n) (setq en (ssname ss i)) (setq ed (entget en)) (setq e1 (cdr (assoc 10 ed)) e2 (cdr (assoc 11 ed)) ) (if (> (distance e1 p) (distance e2 p)) (progn (setq ea e1 eb e2 end 11 ) ) (progn (Setq ea e2 eb e1 end 10 ) ) ) (setq u (uvec ea eb)) (setq d (dot (mapcar '- p ea) u)) (setq ee (mapcar '+ ea (mapcar '* u (list d d d)))) (entmod (subst (cons end ee) (assoc end ed) ed)) (setq i (+ i 1)) ) ; end while (princ) ) ; calculate unit vector from v1 to v2 (defun uvec (v1 v2 / s) (setq s (distance v1 v2)) (setq s (mapcar '/ (mapcar '- v2 v1) (list s s s))) ) ;;; Compute the dot product of 2 vectors a and b (defun dot (a b / dd) (setq dd (mapcar '* a b)) (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd))) ) ;end of dot
    1 point
×
×
  • Create New...