另类拷贝AnotherCopy

669423907

我就是想：
如果选择集为空，就运行画同心圆的程序(txy),
如果选择集为不为空，就运行你那个程序

669423907

我不会啊，我还想在选择集 ss 里加'((8 . "名称1,图号2,数量3,材质4,表格5,6不打印,99图框"))，
不知道该怎么加，还请黄大侠指教

自贡黄明儒

669423907 发表于 2013-7-6 09:20
我不会啊，我还想在选择集 ss 里加'((8 . "名称1,图号2,数量3,材质4,表格5,6不打印,99图框"))，
不知道该怎 ...

1. (defun CC:AC (ss0 / P0)  
   
2. 
   
3.   ;;2  对象na之后所有实体产生的选择集
   
4. 
   
5.   (defun newsel        (na / ss e1)
   
6. 
   
7.     (if        na
   
8. 
   
9.       (setq na (entnext na))
   
10. 
    
11.       (setq na (entnext))
    
12. 
    
13.     )
    
14. 
    
15.     (setq ss (ssadd))
    
16. 
    
17.     (while na
    
18. 
    
19.       (setq e1 (entget na))
    
20. 
    
21.       (if (wcmatch (LI_item 0 e1) "VERTEX,SEQEND,ATTRIB")
    
22. 
    
23.         nil
    
24. 
    
25.         (setq ss (ssadd na ss))
    
26. 
    
27.       )
    
28. 
    
29.       (setq na (entnext na))
    
30. 
    
31.     )
    
32. 
    
33.     ss
    
34. 
    
35.   )
    
36. 
    
37.   ;;3  copy
    
38. 
    
39.   (defun do-copy (ss0 p0 / A BOOL PT SS SS1 SS2)
    
40. 
    
41.     (setq bool T)
    
42. 
    
43.     (setq ss ss0
    
44. 
    
45.           pt p0
    
46. 
    
47.     )
    
48. 
    
49.     (while bool
    
50. 
    
51.       (setq a (entlast))
    
52. 
    
53.       (princ "\n >>下一点或者输入距离:")
    
54. 
    
55.       (command "_.copy" ss "" pt pause)
    
56. 
    
57.       (setq ss1 (newsel a))
    
58. 
    
59.       (ayEntSSHighLight ss)
    
60. 
    
61.       (command "._Select" ss1 "")
    
62. 
    
63.       ;(if (setq ss2 (ssget "_p" '((0 . "*TEXT,ATTDEF,INSERT"))))(SA_change ss2))这句让文字尾数+1
    
64. 
    
65.       (if (equal pt (setq pt (getvar "lastpoint")) 0.001)
    
66. 
    
67.         (progn (command "undo" "2") (setq bool nil))
    
68. 
    
69.       )
    
70. 
    
71.       (setq ss ss1)
    
72. 
    
73.       ;;(princ (getvar 'errno))
    
74. 
    
75.     )
    
76. 
    
77.   )
    
78. 
    
79.   ;;4  主程序
    
80. 
    
81.   (command "undo" "be")
    
82. 
    
83.   (if (and ss0
    
84. 
    
85.            (setq p0 (getpoint "\n >基点:"))
    
86. 
    
87.       )
    
88. 
    
89.     (do-copy ss0 p0)
    
90. 
    
91.   )
    
92. 
    
93.   (command "undo" "e")
    
94. 
    
95.   (princ)
    
96. 
    
97. )
    
98. 
    
99. ;;---------------------------------另类拷贝AnotherCopy
    
100. 
     
101. (defun C:w1 (/ SS0)
     
102.   (if (setq ss0 (ssget))
     
103.     (CC:AC ss0)
     
104.     (dty)
     
105.   )
     
106. )

(defun CC:AC (ss0 / P0)  <br /> <br />   ;;2  对象na之后所有实体产生的选择集<br /> <br />   (defun newsel        (na / ss e1)<br /> <br />     (if        na<br /> <br />       (setq na (entnext na))<br /> <br />       (setq na (entnext))<br /> <br />     )<br /> <br />     (setq ss (ssadd))<br /> <br />     (while na<br /> <br />       (setq e1 (entget na))<br /> <br />       (if (wcmatch (LI_item 0 e1) "VERTEX,SEQEND,ATTRIB")<br /> <br />         nil<br /> <br />         (setq ss (ssadd na ss))<br /> <br />       )<br /> <br />       (setq na (entnext na))<br /> <br />     )<br /> <br />     ss<br /> <br />   )<br /> <br />   ;;3  copy<br /> <br />   (defun do-copy (ss0 p0 / A BOOL PT SS SS1 SS2)<br /> <br />     (setq bool T)<br /> <br />     (setq ss ss0<br /> <br />           pt p0<br /> <br />     )<br /> <br />     (while bool<br /> <br />       (setq a (entlast))<br /> <br />       (princ "\n >>下一点或者输入距离:")<br /> <br />       (command "_.copy" ss "" pt pause)<br /> <br />       (setq ss1 (newsel a))<br /> <br />       (ayEntSSHighLight ss)<br /> <br />       (command "._Select" ss1 "")<br /> <br />       ;(if (setq ss2 (ssget "_p" '((0 . "*TEXT,ATTDEF,INSERT"))))(SA_change ss2))这句让文字尾数+1<br /> <br />       (if (equal pt (setq pt (getvar "lastpoint")) 0.001)<br /> <br />         (progn (command "undo" "2") (setq bool nil))<br /> <br />       )<br /> <br />       (setq ss ss1)<br /> <br />       ;;(princ (getvar 'errno))<br /> <br />     )<br /> <br />   )<br /> <br />   ;;4  主程序<br /> <br />   (command "undo" "be")<br /> <br />   (if (and ss0<br /> <br />            (setq p0 (getpoint "\n >基点:"))<br /> <br />       )<br /> <br />     (do-copy ss0 p0)<br /> <br />   )<br /> <br />   (command "undo" "e")<br /> <br />   (princ)<br /> <br /> )<br /> <br /> ;;---------------------------------另类拷贝AnotherCopy<br /> <br /> (defun C:w1 (/ SS0)<br />   (if (setq ss0 (ssget))<br />     (CC:AC ss0)<br />     (dty)<br />   )<br /> )

669423907

秒杀属性页码递增，太好用了。
如果把标题改为 “复制递增指定对象”，一定会更好的！

669423907

黄大师，不知是否方便帮添加一个功能：
把复制出来的   名称1,数量3,材质4   这三个图层里的文字内容改成 ？（问号），图层的其他信息不变。
为了防止忘了该这三项里某一项的内容，给车间的加工人员造成麻烦，如果他们看见的是 ？，就会及时反馈了。
再次非常感谢你。

我怎么传不了图片？？？？

cocoorange

谢谢楼主分享，辛苦了