动态对象跟着鼠标走

【KAIXIN】

2. 
   
3. ;本程序选择一个对象,让其跟着鼠标走
   
4. (defun c:KK (/  txten wexit gr gr1 p)
   
5. (setq txten (assoc -1 (entget (car (entsel)))))
   
6. (setq wexit nil)
   
7. (while (not wexit)
   
8.     (setq gr  (grread t)
   
9.       gr1 (car gr)
   
10.     )
    
11.     (cond ((= gr1 5)
    
12.        (progn
    
13.          (setq p (cadr gr))
    
14.          (setq p (grreadosnap p))    ;
    
15.          (entmod (list txten (cons 10 p)))
    
16.        )
    
17.       )
    
18.       ((equal gr '(2 6))        ;F3可设置捕捉值
    
19.        (command "_+dsettings" 2)
    
20.       )
    
21.       (t (setq wexit t))
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )
    
26. 
    
27. ;以下程序是围绕pt点画一个框
    
28. (defun grbox (pt / h p1 p2 p3 p4)
    
29.   ;;copy from eachy
    
30.   (setq    h  (* (/ (getvar "viewsize") (cadr (getvar "screensize")))
    
31.           (getvar "pickbox")
    
32.        )
    
33.     p1 (mapcar '- pt (list h h 0.))
    
34.     p2 (mapcar '+ pt (list h (- h) 0.))
    
35.     p3 (mapcar '+ pt (list h h 0.))
    
36.     p4 (mapcar '+ pt (list (- h) h 0.))
    
37.   )
    
38.   (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1))
    
39. )
    
40. ;什么捕捉也没有时,启用所有捕捉功能
    
41. (defun grreadosnap (p / osp osmode str x)
    
42.   ;;grreadosnap ---fsxm 2006.10.06
    
43.   (setq osmode (getvar "osmode"))
    
44.   (cond    ((= osmode 0))
    
45.     ((< osmode 16000)
    
46.      (setq str "")
    
47.      (foreach x '((1 "_end,")
    
48.               (2 "_mid,")
    
49.               (4 "_cen,")
    
50.               (8 "_nod,")
    
51.               (16 "_qua,")
    
52.               (32 "_int,")
    
53.               (64 "_ins,")
    
54.               (128 "_per,")
    
55.               (256 "_tan,")
    
56.               (512 "_nea,")
    
57.               (2048 "_app,")
    
58.               (4096 "_ext,")
    
59.               (8192 "_par,")
    
60.              )
    
61.        (if (/= 0 (logand osmode (car x)))
    
62.          (setq str (strcat str (cadr x)))
    
63.        )
    
64.      )
    
65.      (setq osp (osnap p str))
    
66.      (redraw)
    
67.      (cond (osp
    
68.         (setq p osp)
    
69.         (grbox osp)
    
70.            )
    
71.      )
    
72.     )
    
73.   )
    
74.   p
    
75. )
    

<br /> ;本程序选择一个对象,让其跟着鼠标走<br /> (defun c:KK (/  txten wexit gr gr1 p)<br /> (setq txten (assoc -1 (entget (car (entsel)))))<br /> (setq wexit nil)<br /> (while (not wexit)<br />     (setq gr  (grread t)<br />       gr1 (car gr)<br />     )<br />     (cond ((= gr1 5)<br />        (progn<br />          (setq p (cadr gr))<br />          (setq p (grreadosnap p))    ;<br />          (entmod (list txten (cons 10 p)))<br />        )<br />       )<br />       ((equal gr '(2 6))        ;F3可设置捕捉值<br />        (command "_+dsettings" 2)<br />       )<br />       (t (setq wexit t))<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;以下程序是围绕pt点画一个框<br /> (defun grbox (pt / h p1 p2 p3 p4)<br />   ;;copy from eachy<br />   (setq    h  (* (/ (getvar "viewsize") (cadr (getvar "screensize")))<br />           (getvar "pickbox")<br />        )<br />     p1 (mapcar '- pt (list h h 0.))<br />     p2 (mapcar '+ pt (list h (- h) 0.))<br />     p3 (mapcar '+ pt (list h h 0.))<br />     p4 (mapcar '+ pt (list (- h) h 0.))<br />   )<br />   (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1))<br /> )<br /> ;什么捕捉也没有时,启用所有捕捉功能<br /> (defun grreadosnap (p / osp osmode str x)<br />   ;;grreadosnap ---fsxm 2006.10.06<br />   (setq osmode (getvar "osmode"))<br />   (cond    ((= osmode 0))<br />     ((< osmode 16000)<br />      (setq str "")<br />      (foreach x '((1 "_end,")<br />               (2 "_mid,")<br />               (4 "_cen,")<br />               (8 "_nod,")<br />               (16 "_qua,")<br />               (32 "_int,")<br />               (64 "_ins,")<br />               (128 "_per,")<br />               (256 "_tan,")<br />               (512 "_nea,")<br />               (2048 "_app,")<br />               (4096 "_ext,")<br />               (8192 "_par,")<br />              )<br />        (if (/= 0 (logand osmode (car x)))<br />          (setq str (strcat str (cadr x)))<br />        )<br />      )<br />      (setq osp (osnap p str))<br />      (redraw)<br />      (cond (osp<br />         (setq p osp)<br />         (grbox osp)<br />            )<br />      )<br />     )<br />   )<br />   p<br /> ) <br />

该贴已经同步到 【KAIXIN】的微博

cabinsummer

你最近特喜欢grread啊？

【KAIXIN】

不是，好奇这个，这个还是比较慢

我喜欢通用函数【扩展函数】

飞诗(fsxm)

试下高飞鸟那个动态的，不是这个命令一结束就game over
你做别的事时它也能一直跟着~

cbsz

弄的太麻烦了吧？看看这个怎么样？
(DEFUN C:KK (/ PNT PICKCIRCLE GR FLAG)
       (SETQ PNT (CADR (GRREAD T)))
       (SETQ PICKCIRCLE (LIST '(0 . "CIRCLE") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(100 . "AcDbCircle")
          (APPEND (LIST 10) PNT) '(40 . 1000)));END_SETQ
       (ENTMAKE PICKCIRCLE)
       (SETQ FLAG nil)
(WHILE (NOT FLAG)
       (SETQ GR (GRREAD T))
       (COND
       ((= (CAR GR) 5)
         (ENTMOD (SUBST (APPEND (LIST 10) (CADR (GRREAD T))) (ASSOC 10 (ENTGET (ENTLAST))) (ENTGET (ENTLAST)))))
       (T (PROGN (SETQ FLAG T) (ENTDEL (ENTLAST)))));END_COND
       );END_WHILE
      (PRINC)
      )

vlisp2012

楼上的，不好用啊？！

江湖远人

多谢开心楼主分享，收藏了

zyhandw

的确有很多问题，比如：选择的对象是mtext，mtext对象就会变没有了;选择的是直线的话，直线的一个顶点跟着走;选择多段线时也有问题等等

成仔

貌似挺有意思的，不过用处不大

igumu

貌似挺有意思的，不过用处不大