[LISP程序]：鼠标拖动程序一例--鼠标动态拖拽实时编辑三角形.

lsjjm

鼠标拖动程序一例--鼠标动态拖拽实时编辑三角形.

(defun c:test ()
  (setq loop t)
  (setq pp (getpoint "Pick the Point :" ))
  (setq ss (ssget "c" (polar pp (/ pi 4) 0.01)
                      (polar pp (* 1.25 pi) 0.01)))
  (setq e1 (entget (ssname ss 0)))
  (setq e2 (entget (ssname ss 1)))
  (if (equal (cdr (assoc 10 e1)) pp 0.001)
    (setq e1 (subst (list 10 (car (cdr (assoc 11 e1)))
                             (cadr (cdr (assoc 11 e1))))(assoc 10 e1) e1)
          e1 (subst (list 11 (car (cdr (assoc 10 e1)))
                             (cadr (cdr (assoc 10 e1))))(assoc 11 e1) e1))
  )
  (if (equal (cdr (assoc 10 e2)) pp 0.001)
    (setq e2 (subst (list 10 (car (cdr (assoc 11 e2)))
                                (cadr (cdr (assoc 11 e2))))(assoc 10 e2) e2)
          e2 (subst (list 11 (car (cdr (assoc 10 e2)))
                                    (cadr (cdr (assoc 10 e2))))(assoc 11 e2) e2))
  )
  (while loop
    (setq p (grread T))
    (if (= (car p) 3)(setq loop nil))
    (setq x1 (car (cadr p)))
    (setq y1 (cadr (cadr p)))
    (setq e1 (subst (list 11 x1 y1)(assoc 11 e1) e1))
    (entmod e1)
    (setq e2 (subst (list 11 x1 y1)(assoc 11 e2) e2))
    (entmod e2)
  )
  (princ)
)

snsj

不错，由此可写出模拟MOVE,COPY,ROTATE,MIRROR等动态函数
[php]
(defun zm (et x /) (cdr (assoc x (entget et))))
(defun pzm (nwzm y obj /)
  (entmod(subst(cons y nwzm)(assoc y (entget obj))
                 (entget obj)))
)
(defun c:css (/ ent p)
(setq ent(car(entsel)))  
(while (setq p (grread T))
  (pzm(distance(zm ent 10)(last p))40 ent)
  )
  )
[/php]
测试了一个相当于夹点编辑圆的
可惜的就是不能在GETPOINT的情况下户动