按顺序批量替换块

myfrankie

例如 源块A和目标块B  将块B替换为A 替换后保留A的大小和属性，但也要保留B的位置和方向。可以同时依次点源块 并依次替换目标块 谁能帮我弄一下。谢谢。在线等待

菜卷鱼

有一个没按顺序的

1. (defun osbe ( )
   
2. (setq os-mode (getvar 'osmode))
   
3. (setvar 'osmode 0)
   
4. )
   
5. (defun ose ( )
   
6. (setvar 'osmode os-mode)
   
7. )
   
8. 
   
9. (vl-load-com)
   
10. (defun c:hk ( / name i ar10 ar41  ar42 ar43 ar50 ssa ss info nar41 *error*)
    
11. (defun *error* (s)
    
12. (command "_.undo" "e")
    
13. (setvar 'nomutt 0)
    
14. (setvar 'cmdecho 1)
    
15. )
    
16. (princ "替换块")
    
17. (if (/= namei nil)
    
18. (mapcar 'princ (list "\n输入新的块名:<" namei ">"))
    
19. (mapcar 'princ (list "\n输入新的块名:" ))
    
20. )
    
21. (setq name (getstring ))
    
22. (if (or(= name "")(= name nil))(setq name namei)(setq namei name))
    
23. 
    
24. (setq ss (ssget  '((0 . "insert"))))
    
25. (setq i 0)
    
26. (setvar "cmdecho" 0)
    
27. (command "_.undo" "be")
    
28. (osbe)
    
29. (repeat (sslength ss)
    
30. (setq ssa(ssname ss i))
    
31. (setq info (entget ssa))
    
32. (setq ar10 (cdr (assoc 10 info)))
    
33. (setq ar41 (cdr (assoc 41 info)))
    
34. (setq ar42 (cdr (assoc 42 info)))
    
35. (setq ar43 (cdr (assoc 43 info)))
    
36. (setq ar50 (cdr (assoc 50 info)))
    
37. (setvar "attreq" 0)
    
38. 
    
39. (if (OR(= name "C")(= name "c"))
    
40. (progn
    
41. (if (= i 0)
    
42. (setq nar41(getreal "\n输入半径:<10>")))
    
43. (if (= nar41 nil)(setq nar41 10))
    
44. (progn (setvar 'nomutt 1)
    
45. (command "circle" ar10 nar41)
    
46. (setvar 'nomutt 0))
    
47. )
    
48. (progn
    
49. (setq        mspace (vla-get-modelspace
    
50.                  (vla-get-activedocument (vlax-get-acad-object))
    
51.                  )
    
52.         )
    
53.   (setq 3dp (vlax-3D-point ar10))
    
54. (vla-InsertBlock mspace 3dp name ar41 ar42 ar43 ar50)
    
55. )
    
56. )
    
57. (entdel (ssname ss i))
    
58. (setq i (1+ i))
    
59. )  ;;;repeat
    
60. (ose)
    
61. (command "_.undo" "e")
    
62. (princ (strcat "\n完成" (itoa (sslength ss)) "次替换"))
    
63. (setvar "cmdecho" 1)
    
64. (prin1)
    
65. )

(defun osbe ( )<br /> (setq os-mode (getvar 'osmode))<br /> (setvar 'osmode 0)<br /> )<br /> (defun ose ( )<br /> (setvar 'osmode os-mode)<br /> )<br /> <br /> (vl-load-com)<br /> (defun c:hk ( / name i ar10 ar41  ar42 ar43 ar50 ssa ss info nar41 *error*)<br /> (defun *error* (s)<br /> (command "_.undo" "e")<br /> (setvar 'nomutt 0)<br /> (setvar 'cmdecho 1)<br /> )<br /> (princ "替换块")<br /> (if (/= namei nil)<br /> (mapcar 'princ (list "\n输入新的块名:<" namei ">"))<br /> (mapcar 'princ (list "\n输入新的块名:" ))<br /> )<br /> (setq name (getstring ))<br /> (if (or(= name "")(= name nil))(setq name namei)(setq namei name))<br /> <br /> (setq ss (ssget  '((0 . "insert"))))<br /> (setq i 0)<br /> (setvar "cmdecho" 0)<br /> (command "_.undo" "be")<br /> (osbe)<br /> (repeat (sslength ss)<br /> (setq ssa(ssname ss i))<br /> (setq info (entget ssa))<br /> (setq ar10 (cdr (assoc 10 info)))<br /> (setq ar41 (cdr (assoc 41 info)))<br /> (setq ar42 (cdr (assoc 42 info)))<br /> (setq ar43 (cdr (assoc 43 info)))<br /> (setq ar50 (cdr (assoc 50 info)))<br /> (setvar "attreq" 0)<br /> <br /> (if (OR(= name "C")(= name "c"))<br /> (progn<br /> (if (= i 0)<br /> (setq nar41(getreal "\n输入半径:<10>")))<br /> (if (= nar41 nil)(setq nar41 10))<br /> (progn (setvar 'nomutt 1)<br /> (command "circle" ar10 nar41)<br /> (setvar 'nomutt 0))<br /> )<br /> (progn<br /> (setq        mspace (vla-get-modelspace<br />                  (vla-get-activedocument (vlax-get-acad-object))<br />                  )<br />         )<br />   (setq 3dp (vlax-3D-point ar10))<br /> (vla-InsertBlock mspace 3dp name ar41 ar42 ar43 ar50)<br /> )<br /> )<br /> (entdel (ssname ss i))<br /> (setq i (1+ i))<br /> )  ;;;repeat<br /> (ose)<br /> (command "_.undo" "e")<br /> (princ (strcat "\n完成" (itoa (sslength ss)) "次替换"))<br /> (setvar "cmdecho" 1)<br /> (prin1)<br /> )

myfrankie

怎没高手解决？

gzbccy

myfrankie 发表于 2015-10-31 08:40
怎没高手解决？

高手都好闲哟...

myfrankie

高手都睡着了？？

myfrankie

高手都睡着了？？