找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2761|回复: 11

[每日一码] 俄羅斯方塊 全lisp做的,给大家指点指点 命令为elos

[复制链接]
发表于 2013-9-4 18:44:55 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×

(defun c:elos ()
  (setvar "CMDECHO" 0)
  (ALERT "此程序为胡嘉浚研制,未经许可,不得转发!!!")
  (command "erase" "all" "" "")
  (qianti)
  (setq        insert (ssget "X"
                      '((0 . "LWPOLYLINE")
                        (62 . 4)
                       )
               )
  )                                        ;选中所有

  (setq oldfen 0)

  (fencan)                                ;分层
  (WHILE t
    (xiao)
    (sjm)
    (setq n 240)
    (setq cao_T t)
    (setq cao_R 0)
    (setq guan_list nil)
    (setq X_n 240)
    (N_XN_LIST)
    (huancen)
    (setq guan_list xian_list)
    (WHILE cao_T      
      (caozuo)                                ;操作指令


      (setq X_n (1+ X_n))
      (N_XN_LIST)                        ;计算N_XN_LIST
      (roro)
      (fanwei)                                ;得到出界 chujie是不是为T
      (if (/= t chujie)
        (progn
          (dui)
          (if duit
            (setq cao_T nil)
            (progn             
              (huancen)                        ;换层             
              (setq guan_list xian_list)
              (daodi)
              (yanshi)      
            )
          )
        )
      )
    )
  )
)



(defun fencan ()
  (if (= nil (tblsearch "layer" "xxxxx"))
    (progn
      (command "-layer" "n" "xxxxx" "")
      (command "-layer" "c" "green" "xxxxx" "")
    )
  )
  (if (= nil (tblsearch "layer" "yyyyy"))
    (progn
      (command "-layer" "n" "yyyyy" "")
      (command "-layer" "c" "green" "yyyyy" "")
    )
  )
  (command "change" insert "" "p" "la" "xxxxx" "")
  (command "-layer" "off" "xxxxx" "")
)


(defun caozuo ()                        ;操作
  (setq mo nil)
  (command "regen")
  (setq grd (grread t 8 1))
  (if (= 2 (car grd))

    (progn
      (setq mo (car (cdr grd)))
      (if (= mo 97)
        (xiangyou)
      )
;;;  (if (= mo 115)
;;;    (xiangxia)
;;;  )
      (if (= mo 100)
        (xiangzuo)
      )
      (if (= mo 114)
        (setq cao_r (1+ cao_r))
      )

      (if (and (/= mo 100) (/= mo 97))
        (setq x_n n)
      )
    )
  )

  (if (= 5 (car grd))
    (setq x_n n)
  )
)





(defun xiangyou        ()
  (setq x_n (+ 30 n))
)
(defun xiangxia        ()
  (setq X_n (+ 1 n))
)

(defun xiangzuo        ()
  (setq x_n (- n 30))
)



(defun sjm ()
  (setq sj (atoi (substr (rtos (getvar "date") 2 8) 16 1)))
  (if (or (= sj 2)
          (= sj 5)
          (= sj 8)
          (= sj 0)
      )
    (setq ins "A")
  )
  (if (or (= sj 1)
          (= sj 4)
          (= sj 7)
      )
    (setq ins "B")
  )
  (if (or (= sj 9)
          (= sj 3)
          (= sj 6)
      )
    (setq ins "C")
  )
)




(defun huancen ()
  (mapcar '(lambda (x)                        ;显示与不显示
             (entmod (subst (cons 8 "xxxxx")
                            (assoc 8 (entget (ssname insert x)))
                            (entget (ssname insert x))
                     )
             )
           )
          guan_list
  )

  (mapcar '(lambda (x)
             (entmod (subst (cons 8 "yyyyy")
                            (assoc 8 (entget (ssname insert x)))
                            (entget (ssname insert x))
                     )
             )
           )
          xian_list
  )
  (setq n x_n)                                ;让N 换成NX

)




(defun N_XN_LIST ()
  (if (= ins "A")
    (progn
;;;      (setq guan_list (list n (+ n 1) (+ n 2) (- n 29))) ;土字形
      (setq xian_list (list x_n (+ x_n 1) (+ x_n 2) (- x_n 29)))
    )
  )

  (if (= ins "B")
    (progn
      (setq guan_list (list n (+ 1 n) (- n 30) (- n 29))) ;方形
      (setq xian_list (list x_n (+ 1 x_n) (- x_n 30) (- x_n 29)))
    )
  )

  (if (= ins "C")
    (progn
;;;      (setq guan_list (list n (+ 1 n) (+ 2 n) (+ 3 n))) ;长条形
      (setq xian_list (list x_n (+ 1 x_n) (+ 2 x_n) (+ 3 x_n)))
    )
  )
)



(defun fanwei ()
  (setq chujie nil)
  (mapcar
    '(lambda (x)
       (if
         (= nil
            (and (>= x 0) (<= x 479))
         )
          (setq chujie t)
       )
     )
    xian_list
  )
  (setq ca_list xian_list)
  (setq lin 0)
  (setq gu guan_list)
  (repeat (length gu)
    (setq ca_list (vl-remove (car gu) ca_list))
    (setq gu (cdr gu))
  )

  (if (/= chujie t)
    (progn
      (setq len (LENGTH ca_list))
      (if (and (< len 4) (or (= mo 100) (= mo 97)))
        (progn
          (mapcar
            '(LAMBDA (x)
               (if
                 (= "yyyyy" (cdr (assoc 8 (entget (ssname insert x)))))
                  (setq chujie t)
               )
             )
            ca_list
          )
        )
      )
    )
  )
)



(defun daodi ()
  (mapcar
    '(LAMBDA (x)
       (if (/= nil
               (vl-position
                 x
                 (list 479 449 419 389 359 329 299 269 239 209 179 149
                       119 89 59 29)
               )
           )
         (setq cao_T nil)
       )
     )
    xian_list
  )
)



(defun dui ()
  (setq duit nil)
  (mapcar
    '(LAMBDA (x)
       (if (= "yyyyy" (cdr (assoc 8 (entget (ssname insert x)))))
         (setq duit t)
       )
     )
    ca_list
  )
)


;;;
;;;
;;;(setq ss(ssget "x" '( (410 . "Model"))))
;;;(setq a (list ()))
;;;(setq n 0)
;;;(repeat (ssLENGTH ss)
;;; (if (= 4 (cdr (assoc 62 (entget (ssname ss n)))))
;;;   (setq a(cons n a))
;;;   )
;;;  (setq n (1+ n))
;;;  )



(defun xiao ()
;;;  (setq insert (ssget "X" '((0 . "LWPOLYLINE") (62 . 4))))
  (setq hang 29)
  (setq H_list '())
  (repeat 30
    (setq a_list '())
    (setq xn 0)
    (repeat 16
      (setq xa (+ (* xn 30) hang))
      (setq a_list (cons xa a_list))
      (setq xn (+ xn 1))
    )
    (setq X_T t)
    (mapcar
      '(LAMBDA (x)
         (if
           (= "xxxxx" (cdr (assoc 8 (entget (ssname insert x)))))
            (setq X_T nil)
         )
       )
      a_list
    )

    (if        X_T
      (setq H_list (cons hang H_list))
    )
    (setq hang (- hang 1))
  )

  (if (> (length H_list) 0)
    (progn
      (mapcar '(LAMBDA (H_N)
                 (repeat H_N
                   (setq a_list '())
                   (setq xn 0)
                   (repeat 16
                     (setq xa (+ (* xn 30) H_N))
                     (setq a_list (cons xa a_list))
                     (setq xn (+ xn 1))
                   )
                   (setq b_list '())
                   (setq xn 0)
                   (repeat 16
                     (setq xa (+ (* xn 30) (- H_N 1)))
                     (setq b_list (cons xa b_list))
                     (setq xn (+ xn 1))
                   )
                   (repeat 16
                     (setq b_n (car b_list))
                     (setq a_n (car a_list))
                     (entmod
                       (subst
                         (assoc 8 (entget (ssname insert b_n)))
                         (assoc 8 (entget (ssname insert a_n)))
                         (entget (ssname insert a_n))
                       )
                     )
                     (setq b_list (cdr b_list))
                     (setq a_list (cdr a_list))
                   )
                   (setq H_N (- H_N 1))
                 )
               )
              H_list
      )
    )
  )
  (jiafen)
)







(defun roro ()
  (if (and (= ins "A") (= 0 (rem cao_r 4)))
    (progn
;;;      (setq guan_list xian_list)        ;土字形
      (setq xian_list (list x_n (+ x_n 1) (- x_n 29) (+ x_n 31)))
    )
  )

  (if (and (= ins "A") (= 1 (rem cao_r 4)))
    (progn
;;;      (setq guan_list xian_list)        ;土字形
      (setq xian_list (list x_n (+ x_n 1) (+ x_n 2) (+ x_n 31)))
    )
  )

  (if (and (= ins "A") (= 2 (rem cao_r 4)))
    (progn
;;;      (setq guan_list xian_list)        ;土字形
      (setq xian_list (list (- x_n 29) (+ x_n 1) (+ x_n 2) (+ x_n 31)))
    )
  )
  (if (and (= ins "A") (= 3 (rem cao_r 4)))
    (progn
;;;      (setq guan_list xian_list)        ;土字形
      (setq xian_list (list x_n (+ x_n 1) (+ x_n 2) (- x_n 29)))
    )
  )

  (if (and (= ins "C") (= 1 (rem cao_r 2)))
    (progn
;;;      (setq guan_list xian_list)        ;条形
      (setq xian_list (list (+ 2 x_n) (+ 32 x_n) (+ 62 x_n) (-  x_n 28)))
    )
  )
  (if (and (= ins "C") (= 0 (rem cao_r 2)))
    (progn
;;;      (setq guan_list xian_list)        ;条形
      (setq xian_list (list x_n (+ 1 x_n) (+ 2 x_n) (+ 3 x_n)))
    )
  )
)


(defun qianti ()
  (entmake '((0 . "LWPOLYLINE")
             (5 . "3B198")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (8
              .
              "xxxxx"
             )
             (62 . 4)
             (100 . "AcDbPolyline")
             (90 . 17)
             (70 . 0)
             (43 . 0.0)
             (38 . 0.0)
             (39 . 0.0)
             (10 0.0 0.0)
             (40 . 0.0)
             (41
              .
              0.0
             )
             (42 . 0.0)
             (10 0.25 0.25)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.75 0.25)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 1.0 0.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.0 0.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.0 1.0)
             (40 . 0.0)
             (41
              .
              0.0
             )
             (42 . 0.0)
             (10 0.25 0.75)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.25 0.25)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.75 0.25)
             (40 . 0.0)
             (41 . 0.0)
             (42
              .
              0.0
             )
             (10 1.0 0.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 1.0 1.0)
             (40 . 0.0)
             (41
              .
              0.0
             )
             (42 . 0.0)
             (10 0.75 0.75)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10
              0.75
              0.25
             )
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.75 0.75)
             (40 . 0.0)
             (41 . 0.0)
             (42
              .
              0.0
             )
             (10 0.25 0.75)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.0 1.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 1.0 1.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (210
              0.0
              0.0
              1.0
             )
            )
  )
  (setq fk (entlast))
  (command "-array" fk "" "r" "30" "16" "1" "1")

  (entmake '((0 . "LWPOLYLINE")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (62 . 2)
             (100 . "AcDbPolyline")
             (90 . 4)
             (70 . 1)
             (43 . 0.0)
             (38 . 0.0)
             (39 . 0.0)
             (10 0.0 0.0)
             (40 . 0.0)
             (41
              .
              0.0
             )
             (42 . 0.0)
             (10 16.0 0.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 16.0 30.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (10 0.0 30.0)
             (40 . 0.0)
             (41 . 0.0)
             (42 . 0.0)
             (210 0.0 0.0 1.0)
            )
  )


  (entmake '((0 . "MTEXT")
             (5 . "53A")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (8
              .
              "0"
             )
             (62 . 4)
             (100 . "AcDbMText")
             (10 18.0917 24.0565 0.0)
             (40 . 0.775064)
             (41
              .
              11.2346
             )
             (46 . 8.322)
             (71 . 1)
             (72 . 5)
             (1 . "A向左,D向右,R旋转\n最高分:胡嘉浚->90000 \n你当前的分数为:")
             (7 . "Standard")
             (210 0.0 0.0 1.0)
             (11 1.0 0.0 0.0)
             (42 . 2.35484)
             (43
              .
              1.0162
             )
             (50 . 0.0)
             (73 . 1)
             (44 . 1.0)
            )
  )

  (setq fs (entlast))
  (command "zoom" "all")
)



(defun jiafen ()
  (setq newfen (* (length H_list) 100))
  (setq jfen (+ oldfen newfen))
  (ENTMOD
    (SUBST (CONS 1
                 (STRCAT "A向左,D向右,R旋转\n最高分:胡嘉浚->90000 \n你当前的分数为:"
                         (itoa jfen)
                 )
           )
           (assoc 1 (ENTGET FS))
           (ENTGET FS)
    )
  )
  (setq oldfen jfen)
)




(defun yanshi ()
  (setq T_while t)
  (setq time1 (atoi (substr (rtos (getvar "date") 2 7) 13 2)))
  (setq time2 (+ time1 1))
  (while T_while
    (if        (> (abs (- time2 time1)) 1)
      (setq T_while nil)
      (setq time2 (atoi (substr (rtos (getvar "date") 2 7) 13 2)))
    )
  )
)

QQ截图20130904184256.png

评分

参与人数 1D豆 +5 收起 理由
仲文玉 + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2013-9-4 18:51:02 | 显示全部楼层
不错,绘制完应该有个 Zoom 放大,另外最后局部变量收集下
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-9-4 20:01:54 | 显示全部楼层
顶楼主,这要很大的耐心啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-9-4 20:08:24 | 显示全部楼层
有创意,楼主真牛!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 685个

财富等级: 财运亨通

发表于 2013-9-4 23:30:47 | 显示全部楼层
又一牛人~~~~~~好厉害啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5601个

财富等级: 富甲天下

发表于 2013-9-5 07:58:47 | 显示全部楼层
楼主牛!好创意!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 912个

财富等级: 财运亨通

发表于 2013-9-5 09:58:59 | 显示全部楼层
可以运行,但是无法操作啊。cad版本2012
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6468个

财富等级: 富甲天下

发表于 2013-9-6 13:16:28 | 显示全部楼层
不错,但是还有些BUG,不能快速下落,有时会停顿,卡住不动,要不停的按键,希望作者可以改善。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-9-7 08:09:04 | 显示全部楼层
楼主您真厉害!lsp编程这么复杂的东东。向您学习!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 74个

财富等级: 招财进宝

发表于 2013-9-8 17:33:25 | 显示全部楼层
这是大工程,厉害!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-11-20 22:50:21 | 显示全部楼层
楼主神作啊!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-7-5 23:03:34 | 显示全部楼层
确实是牛阿,新手路过学习了...
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-14 22:05 , Processed in 0.256798 second(s), 58 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表