[抛砖引玉]对象预览函数(grread运用一例)

netbee

实现对象预览功能并支持关键字
ET工具中有acet-ss-drag-move函数，但需要加载ARX，很不方便（我原来的坐标标注就是使用它）
后来决定用LISP来实现！下面的代码就是一个方法，但因为用着MOVE命令，所以对象不能太多。
大家来试试，帖出更优化的代码！

2. 
   
3. ;;;======================
   
4. ;;;NB-ss-drag-move v0.5 2005.12.12
   
5. ;;;替代ET工具中的acet-ss-drag-move函数
   
6. ;;调用(NB-ss-drag-move movess　pt0　msg keyword linetf)
   
7. ;;
   
8. ;;movess:选择集　pt1：基点　msg：提示信息　-
   
9. ;;;keyword：关键字 linetf：拉线显示模式0或nil=无、1＝实线　2=虚线
   
10. ;;;实例：[color=red](NB-ss-drag-move (ssget) (getpoint) "\n确定点或[方位角(A)/字高(H)/选择项(O)]<退出>:" "A H O" 1)[/color]
    
11. (defun NB-ss-drag-move (movess         pt0          msg keyword linetf
    
12.                         /         e0          roop           el            
    
13.                         pt1         pt2          osmode_old   backvar errnew errold set_close
    
14.                        )
    
15.   (defun errnew(errmsg)
    
16.     (set_close)
    
17.     )
    
18.   (defun set_close()
    
19.       (setvar "cmdecho" 1)
    
20.     (setq *error* errold)
    
21.     (setvar "osmode" osmode_old)
    
22.     )
    
23.     ;;--------------------
    
24.     (setq errold *error*
    
25.           *error* errnew)
    
26.   (setq osmode_old (getvar "osmode"))
    
27.   (setvar "osmode" 0)
    
28.   (setvar "cmdecho" 0)
    
29.   (VL-CMDF "_.undo" "be")
    
30.   (if (and linetf
    
31.            (> linetf 0)
    
32.       ) ;_ 结束and
    
33.     (progn (VL-CMDF "_.line" '(0 0) '(1 0) "")
    
34.            (setq l1   (entlast)
    
35.                  entl (entget l1)
    
36.            ) ;_ 结束setq
    
37.     ) ;_ 结束progn
    
38.   ) ;_ 结束if
    
39.   (setq        roop T
    
40.         pt1  pt0
    
41.   ) ;_ 结束setq
    
42.   (prompt (strcat msg "/<退出选择>:"))
    
43.   (while roop
    
44.     (setq el (grread t 2 0))
    
45.     (cond
    
46.       ;;若按下空格或回车
    
47.       ((member el '((2 13) (2 32)))
    
48.        (setq roop nil)
    
49.       )
    
50.       ;;按下其他键
    
51.       ((= (car el) 2)
    
52.        (if (or (vl-string-position (cadr el) (strcase keyword))
    
53.                (vl-string-position (cadr el) (strcase keyword t))
    
54.            ) ;_ 结束or
    
55.          (progn
    
56.            (setq backvar (strcase (chr (cadr el)))
    
57.                  roop         nil
    
58.            ) ;_ 结束setq
    
59.          ) ;_ 结束progn
    
60.          (progn
    
61.            (princ (strcat "\n需要选择对象或关键字：" keyword))
    
62.            (prompt (strcat msg "/<退出选择>:"))
    
63.          ) ;_ 结束progn
    
64.        ) ;_ 结束if
    
65.       )
    
66.       ((= (car el) 25)
    
67.        ;;(menucmd "B2")
    
68.        (setq el nil)
    
69.        ;;(setq roop nil)
    
70.       )
    
71.       ;;移动鼠标
    
72.       ((= (car el) 5)
    
73.        (setq my_viewsize (getvar "viewsize")
    
74.              pt2         (cadr el)
    
75.              di                 (distance pt2 pt1)
    
76.        ) ;_ 结束setq
    
77.        ;;移动距离超过屏幕0.5%则刷新一次     
    
78.        (if (> (/ di my_viewsize) 0.005)
    
79.          (progn
    
80.       (VL-CMDF "_.Move" movess "" pt1 pt2)
    
81.        (setq pt1 pt2)
    
82.        (if (and        linetf
    
83.                 (> linetf 0)
    
84.            ) ;_ 结束and
    
85.          (progn        (setq entl (subst (cons 10 pt0) (assoc 10 entl) entl))
    
86.                 (setq entl (subst (cons 11 pt2) (assoc 11 entl) entl))
    
87.                 (entmod entl)
    
88.          ) ;_ 结束progn
    
89.        ) ;_ 结束if
    
90.        (if (and        linetf
    
91.                 (= linetf 2)
    
92.            ) ;_ 结束and
    
93.          (progn (redraw l1 3))
    
94.        ) ;_ 结束if
    
95.       )
    
96.          )
    
97.       )
    
98.       ((= (car el) 3)
    
99.        (setq backvar (cadr el))
    
100.        (setq roop nil)
     
101.       )
     
102.     ) ;_ 结束cond
     
103.   ) ;_ 结束while
     
104.   (VL-CMDF "_.undo" "e")
     
105.   (VL-CMDF "_.u")
     
106.   (set_close)
     
107.   backvar
     
108. ) ;_ 结束defun
     

<br /> ;;;======================<br /> ;;;NB-ss-drag-move v0.5 2005.12.12<br /> ;;;替代ET工具中的acet-ss-drag-move函数<br /> ;;调用(NB-ss-drag-move movess　pt0　msg keyword linetf)<br /> ;;<br /> ;;movess:选择集　pt1：基点　msg：提示信息　-<br /> ;;;keyword：关键字 linetf：拉线显示模式0或nil=无、1＝实线　2=虚线<br /> ;;;实例：[color=red](NB-ss-drag-move (ssget) (getpoint) "\n确定点或[方位角(A)/字高(H)/选择项(O)]<退出>:" "A H O" 1)[/color]<br /> (defun NB-ss-drag-move (movess         pt0          msg keyword linetf<br />                         /         e0          roop           el            <br />                         pt1         pt2          osmode_old   backvar errnew errold set_close<br />                        )<br />   (defun errnew(errmsg)<br />     (set_close)<br />     )<br />   (defun set_close()<br />       (setvar "cmdecho" 1)<br />     (setq *error* errold)<br />     (setvar "osmode" osmode_old)<br />     )<br />     ;;--------------------<br />     (setq errold *error*<br />           *error* errnew)<br />   (setq osmode_old (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (VL-CMDF "_.undo" "be")<br />   (if (and linetf<br />            (> linetf 0)<br />       ) ;_ 结束and<br />     (progn (VL-CMDF "_.line" '(0 0) '(1 0) "")<br />            (setq l1   (entlast)<br />                  entl (entget l1)<br />            ) ;_ 结束setq<br />     ) ;_ 结束progn<br />   ) ;_ 结束if<br />   (setq        roop T<br />         pt1  pt0<br />   ) ;_ 结束setq<br />   (prompt (strcat msg "/<退出选择>:"))<br />   (while roop<br />     (setq el (grread t 2 0))<br />     (cond<br />       ;;若按下空格或回车<br />       ((member el '((2 13) (2 32)))<br />        (setq roop nil)<br />       )<br />       ;;按下其他键<br />       ((= (car el) 2)<br />        (if (or (vl-string-position (cadr el) (strcase keyword))<br />                (vl-string-position (cadr el) (strcase keyword t))<br />            ) ;_ 结束or<br />          (progn<br />            (setq backvar (strcase (chr (cadr el)))<br />                  roop         nil<br />            ) ;_ 结束setq<br />          ) ;_ 结束progn<br />          (progn<br />            (princ (strcat "\n需要选择对象或关键字：" keyword))<br />            (prompt (strcat msg "/<退出选择>:"))<br />          ) ;_ 结束progn<br />        ) ;_ 结束if<br />       )<br />       ((= (car el) 25)<br />        ;;(menucmd "B2")<br />        (setq el nil)<br />        ;;(setq roop nil)<br />       )<br />       ;;移动鼠标<br />       ((= (car el) 5)<br />        (setq my_viewsize (getvar "viewsize")<br />              pt2         (cadr el)<br />              di                 (distance pt2 pt1)<br />        ) ;_ 结束setq<br />        ;;移动距离超过屏幕0.5%则刷新一次     <br />        (if (> (/ di my_viewsize) 0.005)<br />          (progn<br />       (VL-CMDF "_.Move" movess "" pt1 pt2)<br />        (setq pt1 pt2)<br />        (if (and        linetf<br />                 (> linetf 0)<br />            ) ;_ 结束and<br />          (progn        (setq entl (subst (cons 10 pt0) (assoc 10 entl) entl))<br />                 (setq entl (subst (cons 11 pt2) (assoc 11 entl) entl))<br />                 (entmod entl)<br />          ) ;_ 结束progn<br />        ) ;_ 结束if<br />        (if (and        linetf<br />                 (= linetf 2)<br />            ) ;_ 结束and<br />          (progn (redraw l1 3))<br />        ) ;_ 结束if<br />       )<br />          )<br />       )<br />       ((= (car el) 3)<br />        (setq backvar (cadr el))<br />        (setq roop nil)<br />       )<br />     ) ;_ 结束cond<br />   ) ;_ 结束while<br />   (VL-CMDF "_.undo" "e")<br />   (VL-CMDF "_.u")<br />   (set_close)<br />   backvar<br /> ) ;_ 结束defun<br />

aeo

;;移动距离超过屏幕0.5%则刷新一次     
       (if (> (/ di my_viewsize) 0.005)


算出一个象素比较好
速度是可想而知的
et工具里又一现成的函数

狂刀

能支持相对点更好
比如取第一点之后，输入　100, 即鼠标拉出方向的100距离点。
再支持输入绝对坐标，如(100 100 100) 及　"@100,200,0"等

netbee

速度肯定是比不上用ARX的ACET-SS-DRAG-MOVE的啦！！！
这里只不过是在找一个LISP的方法而已。