关于CAD恢复上次选择对象的LISP

ucuc2003 · 发表于 2013-10-30 00:24

本帖最后由 ucuc2003 于 2013-11-2 20:26 编辑

(defun C:ttt( / ss)
  (princ "恢复上次选择对象")
  (if (setq ss (ssget "_P"))(sssetfirst nil ss))
  (princ (strcat "共选择了" (itoa (sslength ss)) "个对象。"))
  (princ)
)

恢复上次选择by_print1985

llsheng_73 · 发表于 2013-10-30 08:31

sinommw 发表于 2013-10-29 19:41
朋友你这个思路不错，但好像还是不行，我是这么操作的：
我首先输入MOVE1,然后输出T
选择对象: P 没有上 ...

改了一下，开始写的时候没注意到没有执行过的情况

sinommw · 发表于 2013-10-31 01:36

llsheng_73 发表于 2013-10-30 08:31
改了一下，开始写的时候没注意到没有执行过的情况

太厉害了你，这个MOVE2很强大，基本可以无视MOVE1了，随便输入一个键都可以恢复上次选择，这个效果比我预想的方便多了！

下面我指出在一些使用上与默认P的区别：
不能完全代替原MOVE，算是追加了一个命令，在预先选择好对象的情况下，仍需要重新选择上一次对象。
感觉如果要实现_PREVIOUS等透明命令，只有用组合键了，昨天突发奇想，改了CUI，用SHIFT+F，还不错，左手使用起来也很方便，现在问题总算解决了。

在此想举一反三一下：
   一般情况下，镜像，复制，移动，删除等都可能会用到恢复上次选择过的对象。
   既然是追加命令，针对的也是特定的目标，那不如直接跳过第二步，比如直接输入MOVE1，就是默认移动上次选择对象；COPY1，就是默认复制上次选择对象；MIRROR等等，都可以类推。我不懂LISP，不知道这个设想是否容易实现？

多问一句，就你所知，有没有用单个键替换透明命令（诸如_previous,_m2p_mid,_per,_cen,_int，这些改单个键是改不过来的，目前只有用组合键）的办法？如果有，CAD就更加强大了。

再次感谢这位朋友的热心回复！

llsheng_73 · 发表于 2013-10-31 02:49

sinommw 发表于 2013-10-31 01:36
太厉害了你，这个MOVE2很强大，基本可以无视MOVE1了，随便输入一个键都可以恢复上次选择，这个效果比我预 ...

一般说来命令比命令选项好办，CAD可以为命令起别名的，你可以把你不怎么用的那些被占用了的单键改成别的或者直接不要它，让它只有完整命令，而把你自己经常用到的用各个单键去自定它
你可以把CAD安装目录下的acad.pgp用记事本打开，找到
3A,       *3DARRAY
3DO,    *3DORBIT
3F,       *3DFACE
3P,       *3DPOLY
A,       *ARC
AC,       *BACTION
ADC,    *ADCENTER
这些地方，你可以按照这个样子整理这些，至于透明命令这样能不能起作用，你可以随便弄一个试一下就知道了

ㄘ丶转裑ㄧ灬 · 发表于 2013-10-31 15:55

本帖最后由ㄘ丶转裑ㄧ灬于 2016-10-15 11:59 编辑

因为我习惯先选择图元再输入命令，所以下面两个程序在先输入命令的情况下就是上一选择集了；
几年来几乎没用过默认的复制和移动了，反而在其他人的机器上用默认的很不习惯。

;;;;;;********当前或上一选择集的移动及复制
(defun c:a ()
(command "Ortho" "on")
(setq ss (ssget "i"));;;;将已选中的实体加入选择集
(if (= ss nil)
(command ".move" "previous" "");;;;如果选择集为空，则执行移动上一选择集命令
(command ".move");;;;如果选择集不为空，则执行正常移动命令
)
(princ)
)
(defun c:c ()
(command "Ortho" "on")
(setq ss (ssget "i"));;;;将已选中的实体加入选择集
(if (= ss nil)
(command ".copy" "previous" "" "m");;;;如果选择集为空，则执行复制上一选择集命令
(command ".copy" "m");;;;如果选择集不为空，则执行正常复制命令
)
(princ)
)

另外还有一个单独的恢复上一选择集：

;;;****************选中上一选择集（布局空间不起作用）（快捷键为30是因为我把F1映射为0了）
(defun C:30( / ss)
(if (setq ss (ssget "_P"))
(sssetfirst nil ss)
)
(princ)
)

sinommw · 发表于 2013-10-31 21:17

ㄘ丶转裑ㄧ灬发表于 2013-10-31 15:55
贴一下我自己用的代码，新手，简陋之处请包涵。。。
正常区域的代码是直接移动或复制上一选集，（前提是： ...

我试了下，备用代码要优于第一组代码，基本能满足平常使用要求。第二条还特别增加了默认多重复制，非常好用！

想了想完全替代原命令不太可能，这个LISP算是对原命令的补充吧，单独给一个快捷键还好些。

采纳为最佳答案。非常感谢！一并感谢之前各位朋友的热心回复！

gdslqs · 发表于 2013-11-1 13:16

命令：m，按T代替P

(defun c:m ( / msg ss)
(setq msg (strcat "\n请选择对象或[上一个选集(T)]:"))
(SETQ SS (Fsxm-ssget msg "T" '((0 . "*"))))
(cond ( (= ss "T")  (command "move" "P" "")
      )
      ( (= (type ss) 'PICKSET) (command "move" ss "")
      )
      (t nil)
);cond
)
(defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var *acad* *doc* Fsxm-entsel Fsxm-Split Fsxm-Pt2Str)
  (setq *acad* (vlax-get-acad-object))
  (setq *doc* (vla-get-ActiveDocument *acad*))
  (defun Fsxm-entsel (msg filter)
(setq enp (entsel msg))
(if (or (= (type enp) 'str)
         (and enp (ssget (cadr enp) filter))
      )
   enp
)
  );
  (defun Fsxm-Split (string strkey / po strlst xlen)
(setq xlen (1+ (strlen strkey)))
(while (setq po (vl-string-search strkey string))
   (setq strlst (cons (substr string 1 po) strlst))
   (setq string (substr string (+ po xlen)))
)
(reverse (cons string strlst))
  )
  (defun Fsxm-Pt2Str (pt)
(strcat (rtos (car pt) 2 2)
         ","
         (rtos (cadr pt) 2 2)
         ","
         (rtos (caddr pt) 2 2)
         "\n"
)
  )
  (cond
      ((cadr (ssgetfirst)))
      (T
      (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
      (initget (strcat Kwd0 " " kwd))
      (cond ( (and (listp (setq var (Fsxm-entsel Msg Fil)))
                  (/= 52 (getvar "errno"))
               );and
               (vla-sendcommand *doc* (Fsxm-Pt2Str (cadr (grread t))))
               (ssget Fil)
            )
            ((member var (Fsxm-Split Kwd0 " "))
            (vla-sendcommand *doc* (strcat var "\n"))
            (ssget Fil)
            )
            (t var)
      )
      )
  );cond
);defun

sinommw · 发表于 2013-11-1 13:33

gdslqs 发表于 2013-11-1 13:16
命令：m，按T代替P

(defun c:m ( / msg ss)

试了下，命令: M
; 错误: no function definition: VLAX-GET-ACAD-OBJECT

gdslqs · 发表于 2013-11-1 14:14

sinommw 发表于 2013-11-1 13:33
试了下，命令: M
; 错误: no function definition: VLAX-GET-ACAD-OBJECT

加一句(vl-load-com)在最前面

sinommw · 发表于 2013-11-2 19:18

gdslqs 发表于 2013-11-1 14:14
加一句(vl-load-com)在最前面

可以了

账号		自动登录	找回密码
密码			注册

[已解答] 关于CAD恢复上次选择对象的LISP

点评