动态旋转（笔记）
动态旋转
(defun $tu-yuan-xuan-zhuan-dyn$(ents PT0 ro-start-pt
ro-div lst / $ro$
gr gr-p pt-old ro-old
ro-to xunhuan
)
;ents 需要旋转的图元列表
;PT0 旋转基点
;ro-start-pt 是否需要指定旋转起点
;ro-div 角度等分，360度等分为多少个角度
;($tu-yuan-xuan-zhuan-dyn$(SSGET)(getpoint "请指定旋转基点")t 12 nil)
(defun $ro$ (e PT0 ro)
(and e
PT0
ro
(/= ro 0)
(progn
(vla-rotate
(vlax-ename->vla-object e)
(vlax-3D-point PT0)
ro
)
)
)
)
(if (and ents (= (type ents) 'pickset))
(setq ents (vl-remove-if
(function listp)
(mapcar (function cadr) (ssnamex ents))
)
)
)
(setq ents (vl-remove nil ents))
(SETQ PT-OLD NIL)
(or ro-div (setq ro-div 36))
(and
ents
(progn
(setq ro-old nil)
(IF ro-start-pt
(setq PT-OLD (getpoint "旋转起点"))
(setq PT-OLD (cadr (vl-catch-all-apply 'grread (list nil 5 0))))
)
(setq xunhuan t)
(while (and xunhuan PT0)
(setq gr (vl-catch-all-apply 'grread (list nil 5 0)))
(REDRAW)
(and (vl-catch-all-error-p gr)
(progn (setq gr nil) (setq xunhuan nil) t)
)
(and
gr
(progn
(cond
((= (car gr) 5)
(setq gr-p (cadr gr))
(and
PT-OLD
(progn
(if (= (getvar 'ORTHOMODE) 1)
(progn
(setq gr-p
(vl-catch-all-apply
(function
(lambda ()
(zuo-biao-ci-xi pt0 gr-p ro-div)
)
)
)
)
(if (vl-catch-all-error-p gr-p)
(progn (setvar 'ORTHOMODE 0) (setq gr-p nil))
)
)
)
(if gr-p
(progn
(grdraw PT0 gr-p 3)
(setq ro-to
(- (angle PT0 gr-p) (angle PT0 PT-OLD))
)
(mapcar (function (lambda (e) ($ro$ e PT0 ro-to)))
ents
)
)
)
)
)
(SETQ PT-OLD gr-p)
)
((= (car gr) 3)
(setq xunhuan nil)
)
((and (= (car gr) 2) (= (cadr gr) 15))
(setvar 'ORTHOMODE (abs (- (getvar 'ORTHOMODE) 1)))
;翻转
)
)
)
)
)
)
)
ents
)
与rotate命令有啥区别？
页:
[1]