求批量旋转图块

感激过去

平面内有很多很多块，无论相同、不相同，需要可以框选后批量同时旋转X度角。旋转点是各个图块的基点。请帮忙，谢谢···

感激过去

llsheng_73 发表于 2014-2-20 09:52

不能使用呢，请问测试过吗？

yangchao2005090

edata 发表于 2014-2-20 14:15

您好，请问如果设置为默认旋转180度改怎么改呀，也就是箭头掉个头

e54wsj

懂得人,程式就是厲害

llsheng_73

1. (setq x(getreal"要旋转的角度"))
   
2. (if(null x)(setq x 0))
   
3. (setq s(ssget'((0 . "INSERT"))))
   
4. (if s
   
5.   (progn
   
6.     (setq n(sslength s)m 0)
   
7.     (while(< m n)
   
8.       (setq e(entget(ssname s m))
   
9.             m(1+ m))
   
10.       (entmod(subst(cons 50 x)(assoc 50 e)e)))))

(setq x(getreal"要旋转的角度"))<br /> (if(null x)(setq x 0))<br /> (setq s(ssget'((0 . "INSERT"))))<br /> (if s<br />   (progn<br />     (setq n(sslength s)m 0)<br />     (while(< m n)<br />       (setq e(entget(ssname s m))<br />             m(1+ m))<br />       (entmod(subst(cons 50 x)(assoc 50 e)e)))))

菜卷鱼

1. (defun c:sro ( )
   
2. (princ "批量旋转块")
   
3. (setq ang(getreal "\n输入旋转角度:<90>"))
   
4. (if(= ang nil)(setq ang 90))
   
5. (setq ss(ssget '((0 . "INSERT"))))
   
6. (setq i 0)
   
7. (setvar 'cmdecho 0)
   
8. (command "_.undo" "be")
   
9. (repeat (sslength ss)
   
10. (setq ssn(ssname ss i))
    
11. (setq pt0(cdr(assoc 10(entget ssn))))
    
12. (setvar 'NOMUTT 1)
    
13. (command "_.ROTATE" ssn "" pt0 ang )
    
14. (setvar 'NOMUTT 0)
    
15. (setq i(1+ i))
    
16. )
    
17. (command "_.undo" "e")
    
18. (setvar 'cmdecho 1)
    
19. (prin1)
    
20. )

(defun c:sro ( )<br /> (princ "批量旋转块")<br /> (setq ang(getreal "\n输入旋转角度:<90>"))<br /> (if(= ang nil)(setq ang 90))<br /> (setq ss(ssget '((0 . "INSERT"))))<br /> (setq i 0)<br /> (setvar 'cmdecho 0)<br /> (command "_.undo" "be")<br /> (repeat (sslength ss)<br /> (setq ssn(ssname ss i))<br /> (setq pt0(cdr(assoc 10(entget ssn))))<br /> (setvar 'NOMUTT 1)<br /> (command "_.ROTATE" ssn "" pt0 ang )<br /> (setvar 'NOMUTT 0)<br /> (setq i(1+ i))<br /> )<br /> (command "_.undo" "e")<br /> (setvar 'cmdecho 1)<br /> (prin1)<br /> )

感激过去

菜卷鱼 发表于 2014-2-20 12:18

感谢菜卷鱼，测试满足需求，谢谢！

也感谢 llsheng_73 只是对有的块能满足，对个别块旋转的角度不准确，或许是我的块的问题

香田里浪人

菜卷鱼，测试满足需求.

edata

1. (defun c:tt(/ x k s n m en r)
   
2.   (vl-load-com)
   
3.   (setq x(getangle"\n输入需要旋转的角度<归0>:"))
   
4.   (if(null x)(setq x 0 k nil) (setq k t))
   
5.   (setq s(ssget'((0 . "INSERT"))))
   
6.   (if s
   
7.     (progn
   
8.       (setq n(sslength s)m 0)
   
9.       (while(< m n)
   
10.         (setq en(ssname s m)
    
11.               m(1+ m))
    
12.         (if k(setq r (+ (cdr(assoc 50 (entget en))) x))(setq r x))
    
13.         (vla-put-Rotation (vlax-ename->vla-object en) r)
    
14.         )))
    
15.   (princ)
    
16.   )

(defun c:tt(/ x k s n m en r)<br />   (vl-load-com)<br />   (setq x(getangle"\n输入需要旋转的角度<归0>:"))<br />   (if(null x)(setq x 0 k nil) (setq k t))<br />   (setq s(ssget'((0 . "INSERT"))))<br />   (if s<br />     (progn<br />       (setq n(sslength s)m 0)<br />       (while(< m n)<br />         (setq en(ssname s m)<br />               m(1+ m))<br />         (if k(setq r (+ (cdr(assoc 50 (entget en))) x))(setq r x))<br />         (vla-put-Rotation (vlax-ename->vla-object en) r)<br />         )))<br />   (princ)<br />   )

感激过去

edata 发表于 2014-2-20 14:15

感谢edata！代码也一样好用，还带了个整体归0度的功能，更上一筹··

千指魔王

edata 发表于 2014-2-20 14:15

这个只能旋转块，要是能同时旋转文字就更完美了

香田里浪人

千指魔王 发表于 2014-4-20 09:12
这个只能旋转块，要是能同时旋转文字就更完美了

很简单，把(setq s(ssget'((0 . "INSERT"))))
里的"INSERT"改为"INSERT,text"即可。