[分享]：基点跟随的多重复制程序

wkai

copy + m 方式进行复制时，复制的基点总是不变的，大家试试这个基点自动跟随的多重复制方式。
[PHP]
(defun c:tt ()  
  (defun ss:get_after        (ent / ss sub_ent)
    (setq sub_ent '("VERTEX" "SEQEND" "ATTRIB"))
    (setq ss  (ssadd))
    (while (setq ent (entnext ent))
      (if (member (cdr (assoc 0 (entget ent))) sub_ent)
        ()
        (setq ss (ssadd ent ss))
      )
    )
    ss
  )
  (setq ss (ssget))
  (setq p1 (getpoint))
  (while (not (equal p1 pt 1e-4))
    (setq last-ob (entlast))
    (setq pt p1)
    (vl-cmdf "._copy" ss "" "non" pt)
    (while
      (/= 0 (getvar "cmdactive"))
       (vl-cmdf PAUSE)
    )
    (setq ss (ss:get_after last-ob))
    (setq p1 (getvar "lastpoint"))
  )
  (princ)
)
[/PHP]

aidraft

最后回车退出会多出一个拷贝

wkai

漏了一句：
(defun c:tt ()   
  (defun ss:get_after    (ent / ss sub_ent)
    (setq sub_ent '("VERTEX" "SEQEND" "ATTRIB"))
    (setq ss  (ssadd))
    (while (setq ent (entnext ent))
      (if (member (cdr (assoc 0 (entget ent))) sub_ent)
    ()
    (setq ss (ssadd ent ss))
      )
    )
    ss
  )
  (setq ss (ssget))
  (setq p1 (getpoint))
  (while (not (equal p1 pt 1e-4))
    (setq last-ob (entlast))
    (setq pt p1)
    (vl-cmdf "._copy" ss "" "non" pt)
    (while
      (/= 0 (getvar "cmdactive"))
       (vl-cmdf PAUSE)
    )
    (setq ss (ss:get_after last-ob))
    (setq p1 (getvar "lastpoint"))
  )
  (command "._erase" ss "")[/COLOR]   (princ)
)

陌生人

[php]
;; mcp ＝ 带基点连续拷贝－－－－－－陌生人.2004.7
(defun c:mcp ( / ss pt pt2)
  (if (vl-cmdf ".copy" (setq ss (ssget)) "" (setq pt (getpoint "\n复制基点:")) "@")
    (progn
      (while (and (vl-cmdf ".move" ss "" pt pause)
                  (not(equal pt (setq pt2 (getvar "lastpoint")))))
             (vl-cmdf "@" ".copy" ss "" (setq pt pt2) "@")
      )
      (vl-cmdf ".erase" ss "" )
    )
  )
)
[/php]

xiaping

最初由 陌生人 发布
[B][php]
;; mcp ＝ 带基点连续拷贝－－－－－－陌生人.2004.7
(defun c:mcp ( / ss pt pt2)
  (if (vl-cmdf ".copy" (setq ss (ssget)) "" (setq pt (getpoint "\n复制基点:")) "@")
    (progn
      (while (an... [/B]

不错，更简洁。但是，(vl-cmdf "@" ".copy" ss "" (setq pt pt2) "@") 这一句里面第一个"@" 好像是多余的。在2005里面提示“未知命令@"。

陌生人

谢谢提出。这是调试的时候不小心剩下的遗留物，邪门，没有影响程序进程。

wkai

楼上的代码运行起来停顿很明显，不爽！

aeo

最初由 wkai 发布
[B]楼上的代码运行起来停顿很明显，不爽！ [/B]

他相当于4次命令.

而且erase后，上一个选集就没了.

陌生人

(vl-cmdf "._copy" ss "" "non" pt)
    (while
      (/= 0 (getvar "cmdactive"))
       (vl-cmdf PAUSE)
    )
这里只有一个pause，用（getvar "cmdactive") 判断没有必要，这个用法只有当需要响应不定量的pause才有必要用，如copy ss "" "m" ...

且(vl-cmdf "._copy" ss "" "non" pt) 的必然结果是(/=  0(getvar "cmdactive")) ，因此直接pause就可以了

linuxme

最初由 wkai 发布
[B]漏了一句：
(defun c:tt ()   
  (defun ss:get_after    (ent / ss sub_ent)
    (setq sub_ent '("VERTEX" "SEQEND" "ATTRIB"))
    (setq ss  (ssadd))
    (while (setq ent (entnext ent))
      (if... [/B]

一个不太影响使用的小bug，tt后直接空回车应退出程序，不应还要求选择基点
吹毛求疵了
这是目前为止最好的多重复制了，可以看作ET工具中copym的加强版（可定距离）

民工

民工今天跟eachy说起acad自带的复制在多重复制时由于基点始终是第一点而不是“上一点”以至于很不好用时才得知wkai一早已经写了这个程序了而且是两年前的时候真的是很懊恼自己的失败（这句话有3～4个逗号1个句号你们自己加了）

另外，也要批评一下wkai，你当时不应该悄悄的发这个帖子，应该是提着一只火腿2只龙虾来找民工帮你测试测试的......

wkai

:)

hanhang200

我怎麼在網業上面打不了字

fsxm

最初由 陌生人 发布
[B][php]
;; mcp ＝ 带基点连续拷贝－－－－－－陌生人.2004.7
(defun c:mcp ( / ss pt pt2)
  (if (vl-cmdf ".copy" (setq ss (ssget)) "" (setq pt (getpoint "\n复制基点:")) "@")
    (progn
      (while (an... [/B]

速度只是次要的！
如果有个带了与有关联的东东比如dim。hatch等什么的有联系的话
用你这个可是要出错的哦！

雨箭风刀

一个是构造新实体选集再拷贝，一个是先原地拷贝，再移动。
后者多了一个命令，所以速度慢一些，选集内容多的时候会有迟钝。
楼上说的，如果出现这样的问题，那两个程序都会出现（我理解是，都用了cad的基本命令）。
不知道，出错是指怎么个出错法？
另给wkai版主提一条改进意见：
当拷贝的第一次不选基点或不指定拷贝点，而是回车退出的话，没有能干净的退出。