方向键移动实体

love1030312

  用方向键上下左右来控制被选中的实体 按一次移动一定的距离 距离可以设置，不设置的情况下 默认一次移动距离为4毫米  

由于工作大量需求   还请各位大大   G版等大人物帮下忙

                                                                                       再次谢谢各位了

gzcsun

ll_j 发表于 2014-6-30 09:40
多年不搞这个了，周末，家里没有资源，今天到办公室来测试，发一个试试。
传统菜单文件，使用命令menuload ...

向上键不行

664571221

edata 发表于 2014-6-28 22:07
记得prompt可覆盖命令行提示，我找了很久才找到，记忆力不行了。...................................

E大你还年轻吧

296715530

love1030312 发表于 2014-6-30 08:40
你说的那种 我 有

满了能自动排下一版吗？

ZZXXQQ

想起了低版2.6以下版自带的小键盘功能

edata

可以用wsad键控制。。

wxa123wl

;连续复制不用输入距离和方向
(defun c:lxc(/ ss spt ept len1 ang1)
(setvar "osmode" 679)                        ; 打开端点,中点,中心,象限点,交点及垂点捕捉
  (setq spt (getpoint "\n选择基点:"))
  (setq ept (getpoint spt "\n复制的终点(方向):"))
  (setq len1 (getdist "\n复制的距离<默认为起点终点的距离>:"))
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ang1 (angle spt ept))
  (if len1
      (setq ept (polar spt ang1 len1))
  )
  (princ "\n选择要复制的对象")
  (setq ss (ssget))
  (while ss
    (progn
      (command "copy" ss "" spt ept)
        (setq ss (ssget))
    )
  )   
(setvar "osmode" os)
  (prin1)
)
;连续拉伸不用输入距离和方向
(defun c:lxs(/ ss spt ept len1 ang1)
(setvar "osmode" 679)                        ; 打开端点,中点,中心,象限点,交点及垂点捕捉
  (setq spt (getpoint "\n选择基点:"))
  (setq ept (getpoint spt "\n移动的终点(方向):"))
  (setq len1 (getdist "\n拉伸的距离<默认为起点终点的距离>:"))
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ang1 (angle spt ept))
  (if  len1
      (setq ept (polar spt ang1 len1))
  )
  (princ "\n选择要拉伸的对象")
  (setq ss (ssget":s"))
  (while ss
    (progn
      (command "stretch" ss "" spt ept)
        (setq ss (ssget":s"))
    )
  )   
(setvar "osmode" os)
  (prin1)
)
;;连续移动不用回车

(defun c:lxm(/ ss spt ept len1 ang1)
(setvar "osmode" 679)                        ; 打开端点,中点,中心,象限点,交点及垂点捕捉
  (setq spt (getpoint "\n选择基点:"))
  (setq ept (getpoint spt "\n移动的终点(方向):"))
  (setq len1 (getdist "\n移动的距离<默认为起点终点的距离>:"))
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ang1 (angle spt ept))
  (if  len1
      (setq ept (polar spt ang1 len1))
  )
  (princ "\n选择要移动的对象")
  (setq ss (ssget":s"))
  (while ss
    (progn
      (command "move" ss "" spt ept)
        (setq ss (ssget":s"))
    )
  )   
(setvar "osmode" os)
  (prin1)
)

;连续移动不用输入距离和方向
(defun c:lxm0(/ ss spt ept len1 ang1)
(setvar "osmode" 679)                        ; 打开端点,中点,中心,象限点,交点及垂点捕捉
  (setq spt (getpoint "\n选择基点:"))
  (setq ept (getpoint spt "\n移动的终点(方向):"))
  (setq len1 (getdist "\n移动的距离<默认为起点终点的距离>:"))
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ang1 (angle spt ept))
  (if  len1
      (setq ept (polar spt ang1 len1))
  )
  (princ "\n选择要移动的对象")
  (setq ss (ssget))
  (while ss
    (progn
      (command "move" ss "" spt ept)
        (setq ss (ssget))
    )
  )   
(setvar "osmode" os)
  (prin1)
)

;;连续删除不用少一次回车
(defun c:LXE (/ SS)
(setq ss(ssget":s"))
(princ "\n选择要删除的对象")
(command "ERASE" SS "")
(c:LXE)
)

q3_2006

写个排版程序秒杀...EPAI就有....

edata

记得prompt可覆盖命令行提示，我找了很久才找到，记忆力不行了。...................................

1. (defun c:tt(/ GR OLD_CMD SS ds)  
   
2.   (setq old_cmd(getvar 'cmdecho))
   
3.   (setvar 'cmdecho 0)
   
4.   (if (setq ss(ssget))
   
5.     (progn
   
6.       (setq ds(cond((getdist "输入移动间隔<5.0>:")) (5.0)))
   
7.       (princ "\n按W S A D 移动,空格回车左\右键退出:\r")
   
8.   (while (and (/= (car (setq gr(grread t 15 0)))3)
   
9.        (not(equal gr '(2 32)))
   
10.        (not(equal gr '(2 13)))
    
11.        (not(equal gr '(11 0)))
    
12.        (not(equal gr '(25 0)))
    
13.        )   
    
14.     (cond
    
15.       ((or (equal gr '(2 119))(equal gr '(2 87)))      
    
16.        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))
    
17.        (prompt "\r按W S A D 移动,空格回车左\右键退出:向上移动" )
    
18.        )
    
19.       ((or (equal gr '(2 83))(equal gr '(2 115)))      
    
20.        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))
    
21.        (prompt "\r按W S A D 移动,空格回车左\右键退出:向下移动" )
    
22.        )
    
23.       ((or (equal gr '(2 65))(equal gr '(2 97)))
    
24.        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))
    
25.        (prompt "\r按W S A D 移动,空格回车左\右键退出:向左移动")
    
26.        )
    
27.       ((or (equal gr '(2 68))(equal gr '(2 100)))      
    
28.        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))
    
29.        (prompt "\r按W S A D 移动,空格回车左\右键退出:向右移动")
    
30.        )      
    
31.     )
    
32.     )
    
33.       )
    
34.     )
    
35.   (if old_cmd (setvar 'cmdecho old_cmd))
    
36.   (princ)
    
37.   )
    

(defun c:tt(/ GR OLD_CMD SS ds)  <br />   (setq old_cmd(getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (if (setq ss(ssget))<br />     (progn<br />       (setq ds(cond((getdist "输入移动间隔<5.0>:")) (5.0)))<br />       (princ "\n按W S A D 移动,空格回车左\右键退出:\r")<br />   (while (and (/= (car (setq gr(grread t 15 0)))3)<br />        (not(equal gr '(2 32)))<br />        (not(equal gr '(2 13)))<br />        (not(equal gr '(11 0)))<br />        (not(equal gr '(25 0)))<br />        )    <br />     (cond<br />       ((or (equal gr '(2 119))(equal gr '(2 87)))       <br />        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))<br />        (prompt "\r按W S A D 移动,空格回车左\右键退出:向上移动" )<br />        )<br />       ((or (equal gr '(2 83))(equal gr '(2 115)))       <br />        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))<br />        (prompt "\r按W S A D 移动,空格回车左\右键退出:向下移动" )<br />        )<br />       ((or (equal gr '(2 65))(equal gr '(2 97)))<br />        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))<br />        (prompt "\r按W S A D 移动,空格回车左\右键退出:向左移动")<br />        )<br />       ((or (equal gr '(2 68))(equal gr '(2 100)))       <br />        (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))<br />        (prompt "\r按W S A D 移动,空格回车左\右键退出:向右移动")<br />        )      <br />     )<br />     )<br />       )<br />     )<br />   (if old_cmd (setvar 'cmdecho old_cmd))<br />   (princ)<br />   )<br />

ZZXXQQ

;加入新功能

2. (defun c:tt(/ GR SS ds str)  
   
3.   (setvar 'cmdecho 0)
   
4.   (setq ds 4.0)
   
5.   (setq str "按W S A D 移动Q-,E+,空格回车左\右键退出:")
   
6.   (if (setq ss(ssget)) (progn
   
7.    (princ (strcat "\n" str "距离" (rtos ds 2)))
   
8.    (while (and (/= (car (setq gr(grread t 15 0)))3)
   
9.                (not(equal gr '(2 32)))
   
10.                (not(equal gr '(2 13)))
    
11.                (not(equal gr '(11 0)))
    
12.                (not(equal gr '(25 0))))   
    
13.     (cond
    
14.      ((or (equal gr '(2 119))(equal gr '(2 87)))       ;wW
    
15.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))
    
16.       (prompt (strcat "\r" str "向上移动"))
    
17.      )
    
18.      ((or (equal gr '(2 83))(equal gr '(2 115)))       ;Ss
    
19.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))
    
20.       (prompt (strcat "\r" str "向下移动"))
    
21.      )
    
22.      ((or (equal gr '(2 65))(equal gr '(2 97)))        ;Aa
    
23.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))
    
24.       (prompt (strcat "\r" str "向左移动"))
    
25.      )
    
26.      ((or (equal gr '(2 68))(equal gr '(2 100)))       ;Dd
    
27.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))
    
28.       (prompt (strcat "\r" str "向右移动"))
    
29.      )      
    
30.      ((or (equal gr '(2 81))(equal gr '(2 113)))       ;Qq
    
31.       (setq ds (- ds 4) ds (if (< ds 0) 0 ds))
    
32.       (prompt (strcat "\r" str "距离" (rtos ds 2)))
    
33.      )      
    
34.      ((or (equal gr '(2 69))(equal gr '(2 101)))       ;Ee
    
35.       (setq ds (+ ds 4))
    
36.       (prompt (strcat "\r" str "距离" (rtos ds 2)))
    
37.      )      
    
38.     )
    
39.    )
    
40.   ))
    
41.   (setvar 'cmdecho 1)
    
42.   (princ)
    
43. )
    

(defun c:tt(/ GR SS ds str)  <br />   (setvar 'cmdecho 0)<br />   (setq ds 4.0)<br />   (setq str "按W S A D 移动Q-,E+,空格回车左\右键退出:")<br />   (if (setq ss(ssget)) (progn<br />    (princ (strcat "\n" str "距离" (rtos ds 2)))<br />    (while (and (/= (car (setq gr(grread t 15 0)))3)<br />                (not(equal gr '(2 32)))<br />                (not(equal gr '(2 13)))<br />                (not(equal gr '(11 0)))<br />                (not(equal gr '(25 0))))    <br />     (cond<br />      ((or (equal gr '(2 119))(equal gr '(2 87)))       ;wW<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))<br />       (prompt (strcat "\r" str "向上移动"))<br />      )<br />      ((or (equal gr '(2 83))(equal gr '(2 115)))       ;Ss<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))<br />       (prompt (strcat "\r" str "向下移动"))<br />      )<br />      ((or (equal gr '(2 65))(equal gr '(2 97)))        ;Aa<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))<br />       (prompt (strcat "\r" str "向左移动"))<br />      )<br />      ((or (equal gr '(2 68))(equal gr '(2 100)))       ;Dd<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))<br />       (prompt (strcat "\r" str "向右移动"))<br />      )      <br />      ((or (equal gr '(2 81))(equal gr '(2 113)))       ;Qq<br />       (setq ds (- ds 4) ds (if (< ds 0) 0 ds))<br />       (prompt (strcat "\r" str "距离" (rtos ds 2)))<br />      )      <br />      ((or (equal gr '(2 69))(equal gr '(2 101)))       ;Ee<br />       (setq ds (+ ds 4))<br />       (prompt (strcat "\r" str "距离" (rtos ds 2)))<br />      )      <br />     )<br />    )<br />   ))<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )<br />

springwillow

可以参考燕川布衣的cmd+num程序，未知命令反应器，能够实现楼主的要求，修改起来也很简单！

cuyongping

谢谢！收藏了！

love1030312

edata 发表于 2014-6-28 22:07
记得prompt可覆盖命令行提示，我找了很久才找到，记忆力不行了。...................................

谢谢大大们   非常感谢