连续等距复制

qazxswk

看到langjs大神的帖子，http://bbs.mjtd.com/forum.php?mod=viewthread&tid=171879
然后有网友提出，输入复制的距离后，然后按下 R 键，就可以快速复制了。不需要不断地按右键或空格。我试着写了一个。
我感觉，按【F】键连续复制比按R键更为方便，另外，如果在输入复制距离数据后，按【回车】键也可以继续复制。
抛砖引玉，看大家有没有更好的代码。

1. (defun c:11(/ *error* newss_after elast osm ss bb pt pt1 pt2 d r en)
   
2. (defun *error* (msg)(setvar "osmode" osm)(setvar "cmdecho" 1)(princ "\n***复制完成***"))
   
3. (defun newss_after (elast / en ss0)
   
4. (if elast (progn
   
5. (setq ss0 (ssadd))
   
6. (setq en (entnext elast))
   
7. (while en
   
8. (if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))(setq ss0 (ssadd en ss0)))
   
9. (setq en (entnext en))
   
10. )
    
11. ss0 )
    
12. ) )
    
13. 
    
14. (setvar "cmdecho" 0)
    
15. (setq osm (getvar "osmode"))
    
16. (if (and
    
17. (setq ss (ssget)) (setq pt (getpoint "\n选择复制基点:"))
    
18. (setq en (entlast))
    
19. (vl-cmdf "_.copy" ss "" pt pause)
    
20. (setvar "osmode" 16384)
    
21. (setq pt1 (getvar "lastpoint"))
    
22. (setq d (distance pt pt1) r (angle pt pt1))
    
23. )
    
24. (while
    
25. (princ "\n按【F】键或【回车】键连续复制，空格或ESC键退")
    
26. (if d (princ (strcat "<当前复制距离" (rtos d) ">:")))
    
27. (while pt1 (setq bb (grread t 4 2))
    
28. (cond
    
29. ((member bb '((2 13)(2 70)(2 102)))
    
30. (setq ss (newss_after en))
    
31. (setq en (entlast))
    
32. (setq pt2 (polar pt1 r d))
    
33. (vl-cmdf "_.copy" ss "" pt1 pt2)
    
34. )
    
35. ((member bb '((2 32)))(exit))
    
36. )
    
37. )
    
38. (setq pt1 pt2)
    
39. )
    
40. )
    
41. (princ))

(defun c:11(/ *error* newss_after elast osm ss bb pt pt1 pt2 d r en)<br /> (defun *error* (msg)(setvar "osmode" osm)(setvar "cmdecho" 1)(princ "\n***复制完成***"))<br /> (defun newss_after (elast / en ss0)<br /> (if elast (progn <br /> (setq ss0 (ssadd))<br /> (setq en (entnext elast))<br /> (while en <br /> (if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))(setq ss0 (ssadd en ss0)))<br /> (setq en (entnext en))<br /> ) <br /> ss0 )<br /> ) )<br /> <br /> (setvar "cmdecho" 0)<br /> (setq osm (getvar "osmode"))<br /> (if (and <br /> (setq ss (ssget)) (setq pt (getpoint "\n选择复制基点:"))<br /> (setq en (entlast))<br /> (vl-cmdf "_.copy" ss "" pt pause)<br /> (setvar "osmode" 16384)<br /> (setq pt1 (getvar "lastpoint"))<br /> (setq d (distance pt pt1) r (angle pt pt1))<br /> )<br /> (while <br /> (princ "\n按【F】键或【回车】键连续复制，空格或ESC键退")<br /> (if d (princ (strcat "<当前复制距离" (rtos d) ">:")))<br /> (while pt1 (setq bb (grread t 4 2))<br /> (cond<br /> ((member bb '((2 13)(2 70)(2 102)))<br /> (setq ss (newss_after en))<br /> (setq en (entlast))<br /> (setq pt2 (polar pt1 r d))<br /> (vl-cmdf "_.copy" ss "" pt1 pt2)<br /> )<br /> ((member bb '((2 32)))(exit))<br /> )<br /> )<br /> (setq pt1 pt2)<br /> )<br /> )<br /> (princ))

lzspain

有复制上限吗？貌似复制了14次之后就不行了。

qazxswk

lzspain 发表于 2024-6-26 21:37
有复制上限吗？貌似复制了14次之后就不行了。

嗯，有这个情况，因为复制了很多对象，在排查原因中。

qazxswk

lzspain 发表于 2024-6-26 21:37
有复制上限吗？貌似复制了14次之后就不行了。

已经修改好了，多次复制，不会有问题了。

puzb2023

谢谢，很不错

lzspain

qazxswk 发表于 2024-6-27 02:00
已经修改好了，多次复制，不会有问题了。

谢谢，确实可以了。

qazxswk

利用前辈们的一些代码，解决了不能复制动态块和属性块的问题。

jun470

我也是在别人的代码中学习起来的，通过简单改改代码解决繁琐的工作

langjs

潘成祥2015

怎么使用的呀，有文件吗