明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: 鱼与熊掌

[源码] 动态复制,稍微加强版

[复制链接]
发表于 2015-7-18 13:49:11 | 显示全部楼层
感谢楼主分享,,很好用的
发表于 2016-10-17 12:49:47 | 显示全部楼层
很好,赞一个
发表于 2017-11-24 17:30:27 | 显示全部楼层
感谢楼主分享,,很好用
发表于 2017-12-8 09:32:37 | 显示全部楼层
好作品!,但是建议一下数主能不能改成两个方向,跟阵列差不多的那种
发表于 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)
)
发表于 2018-11-1 10:45:22 | 显示全部楼层
请问,怎么将/符号修改为其他字母呢,比如d
发表于 2021-5-21 15:20:07 | 显示全部楼层
好东西就要用力顶顶顶
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-16 08:45 , Processed in 0.171635 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表