批量旋转对象
本帖最后由 sz721 于 2016-1-18 08:18 编辑使所有选定的对象（多行文字，单行文字，引线标示和图块）匹配当前UCS。
下载地址看5楼。
看起来不错哦！ 长老批量发源码啊,赞! 好像不能运行 转发别人的源码时，请保留版权信息！
源码来源：http://www.cadtutor.net/forum/showthread.php?41290-ZeroRotation.lsp-Set-rotation-of-objects-to-zero-(based-on-current-UCS) 这个尊重别人劳动成果很重要 谁可以上传一下吗？五楼地址注册了还是不能下载啊 tumu2008323 发表于 2016-1-17 19:09 static/image/common/back.gif
谁可以上传一下吗？五楼地址注册了还是不能下载啊
;;; ------------------------------------------------------------------------
;;;ZeroRotation.lsp v1.2
;;;
;;;Copyright?03.09.09
;;;Alan J. Thompson (alanjt)
;;;
;;;Contact: alanjt @ TheSwamp
;;;Permission to use, copy, modify, and distribute this software
;;;for any purpose and without fee is hereby granted, provided
;;;that the above copyright notice appears in all copies and
;;;that both that copyright notice and the limited warranty and
;;;restricted rights notice below appear in all supporting
;;;documentation.
;;;
;;;The following program(s) are provided "as is" and with all faults.
;;;Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;;will be uninterrupted and/or error free.
;;;
;;;Set objects (Multileaders, Text, Mtext, Blocks) with a
;;;rotation of 0 (relative to current UCS).
;;;
;;;Revision History:
;;;
;;;v1.1 (10.23.09) 1. Minor rewrite for speed optimization.
;;; v1.2 (05.31.11) 1. Complete rewrite.
;;;
;;; ------------------------------------------------------------------------
(defun c:TE () (c:ZeroRotation))
(defun c:ZeroRotation (/ *error* AT:UCSAngle ang ss name)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (msg)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(defun AT:UCSAngle (/)
;; Return current UCS angle
;; Alan J. Thompson, 04.06.10
((lambda (x) (atan (cadr x) (car x))) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
(if (ssget "_:L" '((0 . "INSERT,MTEXT,MULTILEADER,TEXT")))
(progn
(setq ang (AT:UCSAngle))
(vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
(cond ((vl-position (setq name (vla-get-objectname x)) '("AcDbBlockReference" "AcDbText"))
(vla-put-rotation x ang)
)
((eq name "AcDbMText") (vla-put-rotation x 0.))
((and (eq name "AcDbMLeader") (eq (vla-get-contenttype x) 2))
(vla-put-textrotation x 0.)
)
)
)
(vla-delete ss)
)
)
(*error* nil)
(princ)
)
lucas_3333 发表于 2016-1-17 19:14 static/image/common/back.gif
多谢 输入TE,没反应，这是为什么，2020CAD上测试的。
页:
[1]