Jump to content

Leaderboard

Popular Content

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

  1. this is Tower of hanoi game ( https://en.wikipedia.org/wiki/Tower_of_Hanoi ) almost same as 2048 ; Tower of Hanoi game by autolisp - 2022.05.10 exceed ; https://www.cadtutor.net/forum/topic/75110-2048-by-autolisp/ ; command : ; - HANOI (graphic mode) ; - HANOIT (command prompt text only mode) ; key : A = Pick or Place 1st Pole, S = Pick or Place 2nd Pole, D = Pick or Place 3rd Pole, P = end game ; key : 1 = Pick or Place 1st Pole, 2 = Pick or Place 2nd Pole, 3 = Pick or Place 3rd Pole, 9 = end game ; this lisp use your dwg's space. so you have to run this in new drawing not working dwg. (defun c:HANOIT ( / playcount mover) (setq playcount 0) (setq mover 0) (ex:hanoi 2 0) ) (defun c:HANOI ( / playcount mover) (setq playcount 0) (setq mover 0) (ex:hanoi 2 1) ) (defun ex:hanoi ( level graphicmode / *error* timer starttime score level aindex alist blist clist playlist ) (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) (initget 7) (if (= level nil) (setq level (getint "\n set level"))) (setq aindex 0) (setq alist (list "A")) (setq blist (list "B")) (setq clist (list "C")) (repeat level (setq alist (cons (- level aindex) alist)) (setq aindex (+ aindex 1)) );end of repeat (setq playlist (list (reverse alist) (reverse blist) (reverse clist))) (if (= graphicmode 0) (progn (setq basept (list 0 0 0)) ) (progn (if (= playcount 0) (setq basept (getpoint "\n pick point for game")) ) ) );end of if (outputhanoitxt playlist) (setq start (getstring "\n Start Towers of Hanoi (SpaceBar - Yes / N - No)")) (if (= (strcase start) "N") (progn (princ "\n your time lap is ") (princ timer) (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 (/= sshanoi nil) (command "_.Erase" sshanoi "") ) );end of progn );end of if );end of progn );end of if (exit) );end of progn ) (setq pickhanoi 0) (play playlist basept) (LM:endundo (LM:acdoc)) (setvar 'cmdecho 1) (princ) ) (defun ex:toplist ( playlist / plates1st plates2nd plates3rd p1last index p1len p1atom p2last p2len p2atom p3last p3len p3atom ) (setq p1last (last (car playlist))) (setq p2last (last (cadr playlist))) (setq p3last (last (caddr playlist))) (if (= p1last "A") (setq p1last (* 2 level))) (if (= p2last "B") (setq p2last (* 2 level))) (if (= p3last "C") (setq p3last (* 2 level))) (list p1last p2last p3last) ) (defun play ( playlist basept / nextlev movement input newplaylist rowlen indexr row collen indexc nonezerolist cell calcindex a b c d nonezerolist2 nowtime ) (outputhanoitxt playlist) (if (= (length (caddr playlist)) (+ level 1)) (progn (princ "\n Level ") (princ level) (princ " Complete") (princ " - your time lap is ") (princ timer) (princ " / movement is ") (princ mover) (princ " / ") (princ (- (expt 2 level) 1)) (setq nextlev (getstring "\n Go to the Next Level - Press Any Key")) (setq level (+ level 1)) (setq mover 0) (setq playcount (+ playcount 1)) (ex:hanoi level graphicmode) );end of progn );end of if (setq input (grreadhanoi)) (cond ((= input "A") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (car toplist) picker) (progn (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (car toplist)) (if (< picker (+ level 1)) (progn (princ (car playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (car playlist)) 1) (setq a1 (nth index1 (car playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq mover (+ mover 1)) (setq pickhanoi 1) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (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 (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "S") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (cadr toplist) picker) (progn (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (cadr toplist)) (if (< picker (+ level 1)) (progn (princ (cadr playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (cadr playlist)) 1) (setq a1 (nth index1 (cadr playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 2) (setq mover (+ mover 1)) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (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 (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) (+ maxplatex 4)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "D") (setq toplist (ex:toplist playlist)) (princ "\n toplist - ") (princ toplist) (cond ((/= pickhanoi 0) (princ "\n place mode - from ") (princ pickhanoi) (princ " pole - ") (princ picker) (setq newalist '()) (if (>= (caddr toplist) picker) (progn (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) );end of progn (progn (princ "\n cannot place it") (cond ((= pickhanoi 1) (setq newalist (cons picker (reverse (car playlist)))) (setq newalist (reverse newalist)) (setq playlist (list newalist (cadr playlist) (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 2) (setq newalist (cons picker (reverse (cadr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) newalist (caddr playlist))) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ((= pickhanoi 3) (setq newalist (cons picker (reverse (caddr playlist)))) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 0) (setq picker 0) (if (/= sshanoi2 nil) (command "_.Erase" sshanoi2 "") ) ) ) ) );end of if (setq pickhanoi 0) ) ((= pickhanoi 0) (princ "\n pick mode - ") (setq picker (caddr toplist)) (if (< picker (+ level 1)) (progn (princ (caddr playlist)) (princ picker) (princ " selected") (setq index1 0) (setq newalist '()) (repeat (- (length (caddr playlist)) 1) (setq a1 (nth index1 (caddr playlist))) (setq newalist (cons a1 newalist)) (setq index1 (+ index1 1)) ) (setq newalist (reverse newalist)) (setq playlist (list (car playlist) (cadr playlist) newalist)) (setq pickhanoi 3) (setq mover (+ mover 1)) (if (= graphicmode 1) (progn (setq sshanoi2 (ssadd)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 picker) (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 (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (- (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (+ (+ (+ basepty (* level 2)) 6) 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx (+ 2 (/ maxplatex 2))) (/ (+ 2 (* picker 2)) 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi2) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 picker) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 (vl-princ-to-string picker)) (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) (+ (* maxplatex 2) 8)) (- (+ (+ basepty (* level 2)) 6) 1) 2)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi2) );end of progn );end of if );end of progn (princ "\n cannot pick that, because there is no plate") );end of if ) );end of cond (setq nowtime (getvar "date")) (setq timer (* (- nowtime starttime) 86400.0)) (princ "\n timer - ") (princ timer) (play playlist basept) ) ((= input "P") ;(princ "\n input P") (princ "\n your time lap is ") (princ timer) (princ " / movement is ") (princ mover) (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 (/= sshanoi nil) (command "_.Erase" sshanoi "") ) );end of progn );end of if );end of progn );end of if ); end of "p" );end of cond ) (defun outputhanoitxt ( lst / adjust lstlen indexr row rowlen indexc cell celllen delta outonlylist ) (setq adjust 10) (if (/= sshanoi nil) (command "_.Erase" sshanoi "") ) (setq sshanoi (ssadd)) (setq outonlylist (ex:rotatematrixforhanoi lst "90")) (setq lstlen (length outonlylist)) (setq indexr 0) (repeat lstlen (princ "\n") (setq row (nth indexr outonlylist)) (setq rowlen (length row)) (setq indexc 0) (repeat rowlen (setq cellnum (nth indexc row)) (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 (if (= graphicmode 1) (progn (setq baseptx (car basept)) (setq basepty (cadr basept)) (setq maxplatex (+ 2 (* level 2))) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (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 (+ baseptx 0) (+ basepty 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx 0) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ (* maxplatex 3) 12)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ baseptx (+ (* maxplatex 3) 12)) (+ basepty 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (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 (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (setq xgap (+ maxplatex 4)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (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 (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (setq xgap2 (* xgap 2)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 44) (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 (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap2) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (- (/ maxplatex 2) 1)) xgap2) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap2) (+ (+ basepty (* level 2)) 6))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ (+ (+ baseptx 2) (+ (/ maxplatex 2) 1)) xgap2) (+ basepty 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (if (= (rem (+ (length (car lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ baseptx 2) (/ maxplatex 2)) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (if (= (rem (+ (length (cadr lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (if (= (rem (+ (length (caddr lst)) 1) 2) 0) (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Even") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap2) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn (progn (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 7) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (cons 1 "Odd") (cons 50 0) (cons 41 1) (cons 51 0) (cons 7 "Standard") (cons 71 0) (cons 72 1) (cons 11 (list (+ (+ (+ baseptx 2) (/ maxplatex 2)) xgap2) (+ basepty 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (setq indexr 0) (setq xstack (+ baseptx (+ 2 (/ maxplatex 2)))) (repeat lstlen (princ "\n") (setq row (nth indexr lst)) (setq rowlen (length row)) (setq indexc 0) (setq ystack basepty) (repeat rowlen (setq cellnum (nth indexc row)) (if (and (/= cellnum " ") (/= cellnum "A") (/= cellnum "B") (/= cellnum "C")) (progn (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 62 cellnum) (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 (- xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (- xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 2))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0) (cons 10 (list (+ xstack (/ (+ 2 (* cellnum 2)) 2)) (+ ystack 0))) (cons 40 0.1) (cons 41 0.1) (cons 42 0) (cons 91 0))) (ssadd (entlast) sshanoi) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 62 cellnum) (cons 67 0) (cons 8 "0") (cons 100 "AcDbText") (cons 40 1) (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 (+ xstack 0) (+ ystack 1) 0)) (cons 100 "AcDbText") (cons 73 2))) (ssadd (entlast) sshanoi) );end of progn );end of if (setq ystack (+ ystack 2)) (setq indexc (+ indexc 1)) );end of repeat (setq xstack (+ xstack (+ 4 maxplatex))) (setq indexr (+ indexr 1)) );end of repeat );end of progn );end of if (command "_.Zoom" "O" sshanoi "") (princ "\n Waiting User Input - ") ) (defun ex:rotatematrixforhanoi (lst deg / rowlen oldcollen indexr checkflag row collen indexc rowlist cell topcollen ) ; check matrix (setq rowlen (length lst)) (setq oldcollen (length (nth 0 lst))) (setq indexr 0) (setq checkflag 0) (if (/= checkflag 1) (progn (cond ((= deg "90") (setq rowlen (length lst)) (setq collen (+ level 1)) (setq indexr 0) (setq outputlist '()) (repeat collen (setq indexc 0) (setq rowlist '()) (repeat rowlen (setq cell (nth (- (- collen 1) indexr) (nth indexc lst))) (if (= cell nil) (setq cell " ")) (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 );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.") (princ lst) (exit) );end of progn );end of if );end of defun ; 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 grreadhanoi (/ done) (setq done nil) (while (and (not done) (setq opt (grread T 12 0))) (cond ((or (equal opt '(2 65)) (equal opt '(2 97)) (equal opt '(2 49))) ; input A (setq done T) (princ "\ Input Left (A)") (setq movement "A") ) ((or (equal opt '(2 83)) (equal opt '(2 115)) (equal opt '(2 50))) ; input S (setq done T) (princ "\ Input Down (S)") (setq movement "S") ) ((or (equal opt '(2 68)) (equal opt '(2 100)) (equal opt '(2 51))) ; input D (setq done T) (princ "\ Input Right (D)") (setq movement "D") ) ((or (equal opt '(2 80)) (equal opt '(2 112)) (equal opt '(2 57))) ; input P (setq done T) (princ "\ Input End (P)") (setq movement "P") ) ); cond ); while movement );end of defun ;; 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) ) ) command list HANOI - graphic mode HANOIT - text mode key set (A) a - pick or place 1st pole s - pick or place 2nd pole d - pick or place 3rd pole p - end game or key set (b) 1 - pick or place 1st pole 2 - pick or place 2nd pole 3 - pick or place 3rd pole 9 - end game
    2 points
  2. Would like to have a dialog box to select which DIMSTYLE scale I want to us. Have a look at my multi radio buttons.lspMulti radio buttons.lsp
    1 point
  3. @CADTutor Nope, it never did arrive.
    1 point
  4. I added an "Add Dim Styles" drop-down in a Ribbon panel with macros like: Command Name Anno 0.1 Structure Macro ^C^C^P(or C:Steal (load "StealV1-8.lsp"))(Steal (strcat (vl-filename-directory (getenv "QnewTemplate")) (chr 92) "AutoCAD Template" (chr 92) "Templates.dwt") '(("Dimension Styles"("Anno 0.1 Structure"))))(command-s "-Dimstyle" "Restore" "Anno 0.1 Structure") .regen Since the code is designed to import lists of lists a list of dimensions styles to import as in (list "Dimension Styles" (list "Anno 0.1" "Anno 0.1$2" "Anno 0.18" "Anno 0.18$2" "Anno-0.1-Structure" "Anno-0.18-Structure" "Standard$2" "Structure")) instead of just one in the example macro can be used and remember to include child dimension styles as needed. Couldn't count how often or for how many different types of objects I use Lee Mac's "StealV1-8.lsp" I use a week but it's a lot. Thanks Lee!
    1 point
  5. For that you'd need to use the "_.SCALE" command "Reference" option in the code using the calculated distance between the endpoints. Actually with that lisp you could lengthen from midpoint or either end so it would work for all you lengthen line work.
    1 point
  6. 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
×
×
  • Create New...