社区 › AutoLISP/Visual LISP 编程技术 › 动态复制，稍微加强版

鱼与熊掌 发表于 2014-11-8 18:34:24

动态复制，稍微加强版

本帖最后由 鱼与熊掌 于 2014-11-22 10:29 编辑

2014-11-9 更新。
；优化代码。显示改成左下角显示。
；优化代码。提高效率，避免没必要的操作。
；请下载附件







；如图已经实现动态复制。 按/切换等分模式与复制模式。
；本来已经要优化的，代码也加上了，但是好像没成功
；希望大家发现问题稍微优化一下。
；或者有更好的代码
；感谢~

wudechao 发表于 2018-1-15 21:30:59

我也修改一下，用于表格Y向的动态复制。
(defun c:cdt (/ *error* oos oor p1 p2 pt0 pt1 ss e tst ee cn ns grr gr dis gr)
(setvar "cmdecho" 0)
(defun *error* (msg)
(if oos
   (setvar "osmode" oos)
)
(if oor
   (setvar "orthomode" oor)
)
(redraw)
(setvar "cmdecho" 1)
)
(setq oos (getvar "osmode"))
(setq oor (getvar "orthomode"))
(setq dis (getvar "offsetdist"))
(setvar "orthomode" 1)
(princ "\n选择要复制的物体:")
(setq p2 nil)
(if (setq ss (ssget))
(progn
   (if (< dis 0)
    (progn
   (setq dis 500)
   (setvar "offsetdist" 500)
    )
   )
   (setvar "osmode" 672)
   (setq dis (getdist (strcat "\n指定偏移距离或点选两点距离< " (rtos dis 2 2) " >:"))
       dis (if dis
              dis
              (getvar "offsetdist")
             )
   )
   (setvar "offsetdist" dis)
   (setq pt1 (cadr (grread t 1)))
   (trans pt1 0 1)
   (setq p1 pt1)
   (setq p2 (list (car pt1) (- (cadr pt1) (getvar "offsetdist"))))
   (setq dis (distance p1 p2))
   (setvar "osmode" 0)
   (setq e (entlast))
)
)
(if p2
(progn
   (setq tst t)
   (while tst
    (initget 128)
    (setq grr (grread t 5 0))
    (setq gr (car grr)
          pt0 (cadr grr)
    )
    (cond
   ((= gr 5)
      (redraw)
      (grdraw p1 pt0 1)
      (setq cn (fix (/ (distance p1 pt0) dis)))
      (setq ee e
          ns (ssadd)
      )
      (while (setq ee (entnext ee))
       (setq ns (ssadd ee ns))
      )
      (command "erase" ns "")
      (command "copy" ss "" "m" "non" p1)
      (setq m 0)
      (repeat cn
       (setq m (1+ m))
       (if (or
          (and
             (< (cadr pt0) (cadr p1))
             (> (cadr p1) (cadr p2))
          )
          (and
             (> (cadr pt0) (cadr p1))
             (< (cadr p1) (cadr p2))
          )
           )
        (progn
       (command "non" (mapcar
                       '(lambda (x y)
                           (+ x (* m (- y x)))
                          )
                       p1
                       p2
                        )
       )
        )
        (progn
       (command "non" (mapcar
                       '(lambda (x y)
                           (- x (* m (- y x)))
                          )
                       p1
                       p2
                        )
       )
        )
       )
      )
      (command)
   )
   ((= gr 3)
      (setq tst nil)
   )
   ((or
       (equal grr '(2 32))
       (equal grr '(2 13))
       (member gr '(11 25))
      )
      (setq tst nil)
   )
    )
   )
)
)
(setvar "osmode" oos)
(setvar "orthomode" oor)
(setvar "cmdecho" 1)
(print)
)

再见熊猫衣服 发表于 2021-6-23 16:56:20

非常好用的功能哦。谢谢大佬。。
如果能再次优化一下，按esc则取消操作，这样更好一些。

yuxin6618 发表于 2017-12-8 09:32:37

好作品！,但是建议一下数主能不能改成两个方向,跟阵列差不多的那种

自贡黄明儒 发表于 2014-11-8 19:09:13

楼主进入状态了，赞

琴剑江山_10184 发表于 2014-11-8 22:36:16

5664491 发表于 2014-11-10 19:43:54

好东西，这个必须赞一下

二十七杯酒 发表于 2014-11-11 10:59:54

好东西，收藏了

sfjlx 发表于 2014-11-11 20:27:05

支持一下！也学习一下！

鱼与熊掌 发表于 2014-11-11 20:49:01

自贡黄明儒 发表于 2014-11-8 19:09 static/image/common/back.gif
楼主进入状态了，赞

多谢夸奖，我还有很长的路要走，还得和您多学习

bzhjl 发表于 2014-11-12 20:12:30

厉害~顶帖~

tianyi1230 发表于 2014-11-15 08:37:59

很实用！看起来不错，大量图元不知道速度快否！测试一下！

hooboxu 发表于 2014-11-21 23:51:11

好作品！！！！！

查看完整版本: 动态复制，稍微加强版