004 发表于 2014-5-11 19:53:15

[源码]跟随鼠标旋转

本帖最后由 004 于 2014-5-11 19:54 编辑



;;跟随鼠标旋转
;;wkq004   20140331
(defun c:xx ()
;;临时取消捕捉
;;;(defun ybl-osmode (/ os)
;;;(if (>= (setq os (getvar "osmode")) 16384)
;;;    (setvar "osmode" (- os 16384))
;;;    (setvar "osmode" (+ os 16384))
;;;)
;;;(princ)
;;;)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(princ "\n选择要旋转的对象：")
(setq ss (ssget))
(repeat (setq i (sslength ss))
    (redraw (ssname ss (1- i)) 3)
)
(setq pt (getpoint"\n指定基点："))
;;;(ybl-osmode)
;;;(command "_.delay" 100)

(entmake (list '(0 . "LINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbLine")
                         (cons 10 pt)
                         (cons 11 (polar pt 0 0.001))
                         '(62 . 7)
                         '(210 0. 0. 1.)
                   )
          )
(setq      e (entlast)
)
(setq el (entget e))
(setq cs 40)
(while (> cs 0)
    (if      (and (setq TMP (grread t 7 1)) (= (car TMP) 5))
      (progn      
      (setq cs (1- cs))
      (setq el (subst (cons 11 (cadr tmp)) (assoc 11 el) el))
      (entmod el)
      )
    )
)
(entdel e)
;;;(grread t 7 1)
(command ".rotate"
         ss
         ""
         pt
         "r"
         pt
         (cond ((and (setq TMP (grread t 7 1)) (= (car TMP) 5)) ;_移动
                  (setq PT2 (cadr TMP))
               )
         )
         pause
)

(setvar "osmode" os)
;;;(ybl-osmode)
)

lingduwx 发表于 2014-6-16 11:10:03

这个功能非常实用，实际应用中发现指定基点的时候无法捕捉，需要每次单独设置捕捉，
另外如果可以增加一个功能就更好了，就是指定基点之后，如果直接输入数字即为旋转角度，鼠标点击的话，则是更随鼠标，那样就更完美了，希望楼主修改一下，谢谢

519995995 发表于 2014-6-28 00:08:26

支持 源码，明经有你更精彩。
2楼的功能正是我想要的。希望楼主为大家花点时间，我等

qq1254582201 发表于 2015-11-25 21:47:41

就是不太灵敏，无法捕捉哦

尘缘一生 发表于 2016-6-5 23:13:50

为本代码进一步增强修改：

1：取消定位点，减小动作，加快画图速度。
2：最后跟随鼠标定位。
;;跟随鼠标旋转+移动定位
(defun c:xx (/ os ss i pt e e1 cs tmp pt2)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(princ "\n选择要旋转的对象：")
(setq ss (ssget))
(repeat (setq i (sslength ss))
    (redraw (ssname ss (1- i)) 3)
)
(setq pt (nth 1 (grread 5)))
(entmake (list '(0 . "LINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbLine")
       (cons 10 pt)
       (cons 11 (polar pt 0 0.001))
       '(62 . 7)
       '(210 0. 0. 1.)
       )
    )
(setqe (entlast)
)
(setq el (entget e))
(setq cs 40)
(while (> cs 0)
    (if(and (setq TMP (grread t 7 1)) (= (car TMP) 5))
      (progn
(setq cs (1- cs))
(setq el (subst (cons 11 (cadr tmp)) (assoc 11 el) el))
(entmod el)
      )
    )
)
(entdel e)
(command ".rotate"
   ss
   ""
   pt
   "r"
   pt
   (cond ((and (setq TMP (grread t 7 1)) (= (car TMP) 5)) ;_移动
      (setq PT2 (cadr TMP))
   )
   )
   pause
)
(command "MOVE" ss "" pt2)
(setvar "osmode" os)
)
页: [1]
查看完整版本: [源码]跟随鼠标旋转