方向键移动实体

love1030312 发表于 2014-6-28 14:46:38

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

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

再次谢谢各位了

gzcsun 发表于 2021-12-12 21:55:25

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

向上键不行

664571221 发表于 2020-8-22 16:19:35

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

E大你还年轻吧

296715530 发表于 2019-12-12 15:02:32

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

满了能自动排下一版吗？

ZZXXQQ 发表于 2014-6-28 20:38:04

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

edata 发表于 2014-6-28 20:56:24

可以用wsad键控制。。

wxa123wl 发表于 2014-6-28 21:31:32

;连续复制不用输入距离和方向
(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))
(iflen1
   (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))
(iflen1
   (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))
(iflen1
   (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 发表于 2014-6-28 21:37:27

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

edata 发表于 2014-6-28 22:07:20

本帖最后由 edata 于 2014-6-28 22:23 编辑

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

ZZXXQQ 发表于 2014-6-29 08:48:27

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

springwillow 发表于 2014-6-29 10:17:28

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

cuyongping 发表于 2014-6-29 12:11:01

谢谢！收藏了！

love1030312 发表于 2014-6-30 08:18:58

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

谢谢大大们非常感谢

页: [1] 2 3

明经CAD社区's Archiver

方向键移动实体