本帖最后由 langjs 于 2022-6-9 21:35 编辑


;;; __________________________________________
;;; 连续复制3.0     langjs         2021.07.25
;;; 命令:fz      右键默认距离复制  esc键退出
;;; __________________________________________
(defun c:fz (/ #err4 $orr d en p0 p1 r snap ss)
  (defun ssnext (en / ss)
    (setq ss (ssadd))
    (while (setq en (entnext en))
      (if (not (member (cdr (assoc 0 (entget en))) (list "ATTRIB" "VERTEX" "SEQEND")))
        (setq ss (ssadd en ss)))) ss)
  (defun #err4 (s)
    (command ".UNDO" "E")
    (setvar "osmode" snap)
    (setq *error* $orr))
  (setq snap (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setq $orr *error* *error* #err4 )
  (if (setq ss (ssget))
    (if (setq p0 (getpoint "\n指定基点:"))
      (progn
        (while t
          (command ".UNDO" "BE")
          (princ "\n指定下一点或距离:")
          (if d (progn (setvar "osmode" 0) (princ (strcat "<" (rtos d) ">:"))))
          (setq en (entlast))
          (command ".copy" ss "" p0 pause)
          (command ".erase" (ssnext en) "")
          (setq p1 (getvar "lastpoint"))
          (if (equal p0 p1 1e-8)
            (setq p1 (polar p0 r d))
            (setq d (distance p0 p1)  r (angle p0 p1)))
          (if (not (equal p0 p1 1e-8))
            (progn
              (setq en (entlast))
              (command ".copy" ss "" p0 p1)
              (setq ss (ssnext en)  p0 p1 ) ) )
          (command ".UNDO" "E")))))
  (setq *error* $orr)
  (princ)
)





网友答:
想改为：空格键按上次的距离和方向复制图元，右键退出不知道怎么改

网友答: 本帖最后由 tryhi 于 2016-4-4 17:02 编辑
写得不错，稍微修改了下后自用，主要改了两个地方，复制时保持原有的捕捉设置，不强制设置为0，还有就是复制的时候不采取先复制后删除的方式，这样对于大量图形可以明显提高速度。还有就是退出函数你这样写有点多余，直接局部定义*error*即可

网友答:
看看我的帖子 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=190502
把我的帖子中：(member bb '((2 13)(2 70)(2 102)))  改为 (member bb '((2 32)))
((member bb '((2 32)))(exit))  改为  ((=(car bb) 25)(exit))
这样就实现你的要求了。至于方向键复制图元，实现不了，因为方向键没有grread对应按键值

网友答:

网友答: 感谢分享学习!!!!

网友答:

网友答: mark 一下，以备不时之需

网友答: 好东西，谢谢分享

网友答: 怎么复制下来用不了

网友答: 使用的时候，命令栏有乱码，请问这个是什么原因？

网友答: 需要成品yige哈哈