批量旋转对象

sz721

使所有选定的对象（多行文字，单行文字，引线标示和图块）匹配当前UCS。


下载地址看5楼。

xiaolong1487

看起来不错哦！

lucas_3333

长老批量发源码啊,赞!

香田里浪人

好像不能运行

Gu_xl

转发别人的源码时，请保留版权信息！
源码来源：http://www.cadtutor.net/forum/sh ... of-objects-to-zero-(based-on-current-UCS)

习习谷风

这个  尊重别人劳动成果很重要

tumu2008323

谁可以上传一下吗？五楼地址注册了还是不能下载啊

lucas_3333

tumu2008323 发表于 2016-1-17 19:09
谁可以上传一下吗？五楼地址注册了还是不能下载啊

1. ;;; ------------------------------------------------------------------------
   
2. ;;;  ZeroRotation.lsp v1.2
   
3. ;;;
   
4. ;;;  Copyright?03.09.09
   
5. ;;;  Alan J. Thompson (alanjt)
   
6. ;;;
   
7. ;;;  Contact: alanjt @ TheSwamp
   
8. ;;;  Permission to use, copy, modify, and distribute this software
   
9. ;;;  for any purpose and without fee is hereby granted, provided
   
10. ;;;  that the above copyright notice appears in all copies and
    
11. ;;;  that both that copyright notice and the limited warranty and
    
12. ;;;  restricted rights notice below appear in all supporting
    
13. ;;;  documentation.
    
14. ;;;
    
15. ;;;  The following program(s) are provided "as is" and with all faults.
    
16. ;;;  Alan J. Thompson DOES NOT warrant that the operation of the program(s)
    
17. ;;;  will be uninterrupted and/or error free.
    
18. ;;;
    
19. ;;;  Set objects (Multileaders, Text, Mtext, Blocks) with a
    
20. ;;;  rotation of 0 (relative to current UCS).
    
21. ;;;
    
22. ;;;  Revision History:
    
23. ;;;
    
24. ;;;  v1.1 (10.23.09) 1. Minor rewrite for speed optimization.
    
25. ;;;     v1.2 (05.31.11) 1. Complete rewrite.
    
26. ;;;
    
27. ;;; ------------------------------------------------------------------------
    
28. 
    
29. (defun c:TE () (c:ZeroRotation))
    
30. (defun c:ZeroRotation (/ *error* AT:UCSAngle ang ss name)
    
31. 
    
32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
35. 
    
36. 
    
37.   (defun *error* (msg)
    
38.     (and *AcadDoc* (vla-endundomark *AcadDoc*))
    
39.     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
    
40.       (princ (strcat "\nError: " msg))
    
41.     )
    
42.   )
    
43. 
    
44. 
    
45.   (defun AT:UCSAngle (/)
    
46.     ;; Return current UCS angle
    
47.     ;; Alan J. Thompson, 04.06.10
    
48.     ((lambda (x) (atan (cadr x) (car x))) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T))
    
49.   )
    
50. 
    
51. 
    
52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
53. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
55. 
    
56.   (vl-load-com)
    
57. 
    
58.   (vla-startundomark
    
59.     (cond (*AcadDoc*)
    
60.           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    
61.     )
    
62.   )
    
63. 
    
64.   (if (ssget "_:L" '((0 . "INSERT,MTEXT,MULTILEADER,TEXT")))
    
65.     (progn
    
66.       (setq ang (AT:UCSAngle))
    
67.       (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
    
68.         (cond ((vl-position (setq name (vla-get-objectname x)) '("AcDbBlockReference" "AcDbText"))
    
69.                (vla-put-rotation x ang)
    
70.               )
    
71.               ((eq name "AcDbMText") (vla-put-rotation x 0.))
    
72.               ((and (eq name "AcDbMLeader") (eq (vla-get-contenttype x) 2))
    
73.                (vla-put-textrotation x 0.)
    
74.               )
    
75.         )
    
76.       )
    
77.       (vla-delete ss)
    
78.     )
    
79.   )
    
80.   (*error* nil)
    
81.   (princ)
    
82. )

;;; ------------------------------------------------------------------------<br /> ;;;  ZeroRotation.lsp v1.2<br /> ;;;<br /> ;;;  Copyright?03.09.09<br /> ;;;  Alan J. Thompson (alanjt)<br /> ;;;<br /> ;;;  Contact: alanjt @ TheSwamp<br /> ;;;  Permission to use, copy, modify, and distribute this software<br /> ;;;  for any purpose and without fee is hereby granted, provided<br /> ;;;  that the above copyright notice appears in all copies and<br /> ;;;  that both that copyright notice and the limited warranty and<br /> ;;;  restricted rights notice below appear in all supporting<br /> ;;;  documentation.<br /> ;;;<br /> ;;;  The following program(s) are provided "as is" and with all faults.<br /> ;;;  Alan J. Thompson DOES NOT warrant that the operation of the program(s)<br /> ;;;  will be uninterrupted and/or error free.<br /> ;;;<br /> ;;;  Set objects (Multileaders, Text, Mtext, Blocks) with a<br /> ;;;  rotation of 0 (relative to current UCS).<br /> ;;;<br /> ;;;  Revision History:<br /> ;;;<br /> ;;;  v1.1 (10.23.09) 1. Minor rewrite for speed optimization.<br /> ;;;     v1.2 (05.31.11) 1. Complete rewrite.<br /> ;;;<br /> ;;; ------------------------------------------------------------------------<br /> <br /> (defun c:TE () (c:ZeroRotation))<br /> (defun c:ZeroRotation (/ *error* AT:UCSAngle ang ss name)<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br /> <br />   (defun *error* (msg)<br />     (and *AcadDoc* (vla-endundomark *AcadDoc*))<br />     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))<br />       (princ (strcat "\nError: " msg))<br />     )<br />   )<br /> <br /> <br />   (defun AT:UCSAngle (/)<br />     ;; Return current UCS angle<br />     ;; Alan J. Thompson, 04.06.10<br />     ((lambda (x) (atan (cadr x) (car x))) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T))<br />   )<br /> <br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br />   (vl-load-com)<br /> <br />   (vla-startundomark<br />     (cond (*AcadDoc*)<br />           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))<br />     )<br />   )<br /> <br />   (if (ssget "_:L" '((0 . "INSERT,MTEXT,MULTILEADER,TEXT")))<br />     (progn<br />       (setq ang (AT:UCSAngle))<br />       (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))<br />         (cond ((vl-position (setq name (vla-get-objectname x)) '("AcDbBlockReference" "AcDbText"))<br />                (vla-put-rotation x ang)<br />               )<br />               ((eq name "AcDbMText") (vla-put-rotation x 0.))<br />               ((and (eq name "AcDbMLeader") (eq (vla-get-contenttype x) 2))<br />                (vla-put-textrotation x 0.)<br />               )<br />         )<br />       )<br />       (vla-delete ss)<br />     )<br />   )<br />   (*error* nil)<br />   (princ)<br /> )

tumu2008323

lucas_3333 发表于 2016-1-17 19:14

多谢

litianwu8900

输入TE,没反应，这是为什么，2020CAD上测试的。