[求助]：求教GRREAD的用法！斑竹教教我啊，eachy、xyp、aeo、wkai、狂刀.......

Dallas_whu · 发表于 2005-11-18 10:42:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

那位大侠能给我详细介绍一下GRREAD的用法，比帮助文件的更为详细的。因为帮助文件看的不是很懂，能有例子就更好了。例如如何响应鼠标左、右键，如何响应[ESC]等等。
请各位大侠不吝赐教啊!谢谢

yxpxa · 发表于 2005-11-19 00:18:45

给你一个我收藏的例程，你研究一下，命令zw

(defun drawbox ()
(grdraw ll ul -1)
(grdraw ul ur -1 1)
(grdraw ur lr -1 1)
(grdraw lr ll -1 1)
(if (= mode 0)
(cenx)
(arrow)
)
)
(defun cenx ()
(grdraw x1 x2 -1)
(grdraw x3 x4 -1)
)
(defun arrow ()
(grdraw a1 a4 -1)
(grdraw a2 a4 -1)
(grdraw a3 a4 -1)
)
(defun newbox () ;_求各线段的端点，包括矩形、箭头和交叉X线
(setq deltay (* deltax aspect))
(setq xcen (car center)
ycen (cadr center)
)
(setq lx (- xcen deltax)
ux (+ xcen deltax)
)
(setq ly (- ycen deltay)
uy (+ ycen deltay)
)
(setq ll (list lx ly)
ul (list lx uy)
)
(setq ur (list ux uy)
lr (list ux ly)
)
(setq yp (+ ycen arm)
ym (- ycen arm)
)
(setq a1 (list (- ux arm) yp)
a2 (list (- ux arm) ym)
)
(setq a3 (list (- ux arm arm) ycen))
(setq a4 (list ux ycen))
(setq x1 (list (- xcen arm) ym)
x2 (list (+ xcen arm) yp)
)
(setq x3 (list (- xcen arm) yp)
x4 (list (+ xcen arm) ym)
)
(drawbox)
)
(defun C:ZW (/ arm aspect deltax inp loop mode prev pt source)
(setq center (getvar "viewctr")) ;_屏幕中心
(setvar "lastpoint" (setq prev center))
(setq
aspect (/ (cadr (setq aspect (getvar "screensize"))) (car aspect))
)
(setq deltax (* 0.25 (getvar "viewsize"))) ;_当前窗口大小(绘图单位)
(setq arm (* 0.1 deltax)
mode 0
loop t
)
(newbox)
(while loop
(setq inp (grread t)) ;_返回当前光标坐标
(setq source (car inp)
pt (cadr inp)
)
(cond ((= source 3) ;_source=3表示单击左键
(cenx)
(arrow)
(setq mode (- 1 mode))
(setvar "lastpoint" center)
)
((= source 5)
(if (or (/= (car prev) (car pt))
(/= (cadr prev) (cadr pt))
)
(progn
(if (= mode 0)
(setq center pt)
(setq deltax (+ deltax (- (car pt) (car prev))))
)
(setq prev pt)
(drawbox)
(newbox)
)
)
)
((or (and (= source 6) (= pt 0))
(and (= source 2)
(or (= pt 13) (= pt 32))
)
)
(drawbox)
(command "zoom" "w" ll ur)
(setq loop nil)
)
(t
(drawbox)
(setq loop nil
a "^cancel"
)
)
)
)
)

(defun drawbox () 
  (grdraw ll ul -1) 
  (grdraw ul ur -1 1) 
  (grdraw ur lr -1 1) 
  (grdraw lr ll -1 1) 
  (if (= mode 0) 
    (cenx) 
    (arrow) 
  ) 
) 
(defun cenx () 
  (grdraw x1 x2 -1) 
  (grdraw x3 x4 -1) 
) 
(defun arrow () 
  (grdraw a1 a4 -1) 
  (grdraw a2 a4 -1) 
  (grdraw a3 a4 -1) 
) 
(defun newbox () ;_求各线段的端点，包括矩形、箭头和交叉X线 
  (setq deltay (* deltax aspect)) 
  (setq        xcen (car center) 
        ycen (cadr center) 
  ) 
  (setq        lx (- xcen deltax) 
        ux (+ xcen deltax) 
  ) 
  (setq        ly (- ycen deltay) 
        uy (+ ycen deltay) 
  ) 
  (setq        ll (list lx ly) 
        ul (list lx uy) 
  ) 
  (setq        ur (list ux uy) 
        lr (list ux ly) 
  ) 
  (setq        yp (+ ycen arm) 
        ym (- ycen arm) 
  ) 
  (setq        a1 (list (- ux arm) yp) 
        a2 (list (- ux arm) ym) 
  ) 
  (setq a3 (list (- ux arm arm) ycen)) 
  (setq a4 (list ux ycen)) 
  (setq        x1 (list (- xcen arm) ym) 
        x2 (list (+ xcen arm) yp) 
  ) 
  (setq        x3 (list (- xcen arm) yp) 
        x4 (list (+ xcen arm) ym) 
  ) 
  (drawbox) 
) 
(defun C:ZW (/ arm aspect deltax inp loop mode prev pt source) 
  (setq center (getvar "viewctr")) ;_屏幕中心 
  (setvar "lastpoint" (setq prev center)) 
  (setq 
    aspect (/ (cadr (setq aspect (getvar "screensize"))) (car aspect)) 
  ) 
  (setq deltax (* 0.25 (getvar "viewsize"))) ;_当前窗口大小(绘图单位) 
  (setq        arm  (* 0.1 deltax) 
        mode 0 
        loop t 
  ) 
  (newbox) 
  (while loop 
    (setq inp (grread t)) ;_返回当前光标坐标 
    (setq source (car inp) 
          pt         (cadr inp) 
    ) 
    (cond ((= source 3) ;_source=3表示单击左键 
           (cenx) 
           (arrow) 
           (setq mode (- 1 mode)) 
           (setvar "lastpoint" center) 
          ) 
          ((= source 5) 
           (if (or (/= (car prev) (car pt)) 
                   (/= (cadr prev) (cadr pt)) 
               ) 
             (progn 
               (if (= mode 0) 
                 (setq center pt) 
                 (setq deltax (+ deltax (- (car pt) (car prev)))) 
               ) 
               (setq prev pt) 
               (drawbox) 
               (newbox) 
             ) 
           ) 
          ) 
          ((or (and (= source 6) (= pt 0)) 
               (and (= source 2) 
                    (or (= pt 13) (= pt 32)) 
               ) 
           ) 
           (drawbox) 
           (command "zoom" "w" ll ur) 
           (setq loop nil) 
          ) 
          (t 
           (drawbox) 
           (setq loop nil 
                 a    "^cancel" 
           ) 
          ) 
    ) 
  ) 
)

Dallas_whu · 发表于 2005-11-19 11:52:05

谢谢2楼的，希望其他高手也能传授一点啊！

taner · 发表于 2005-11-19 12:06:41

有同感,有些东西看说明总是糊里糊涂的,希望高手解说一下.

似水无痕 · 发表于 2005-11-19 14:34:51

这里还有一个：

[FONT=courier new]
(defun c:cs ()
(command "text" (cadr (grread t 1 0)) "300" "0" "test") ;先生成文字
(setq YH_textname (entlast))
(while (= (car (setq YH_mouse (grread t 1 0))) 5)
(setq YH_gettext (entget YH_textname))
(setq YH_textpoint (cadr YH_mouse))
(setq YH_gettext
(subst (cons 10 YH_textpoint)
(assoc 10 YH_gettext)
YH_gettext
)
)
(entmod YH_gettext)
)
(princ)
)
[/FONT]

HuaiYu · 发表于 2005-11-19 20:57:10

学习中。。
这里的高手真多

xyp1964 · 发表于 2005-11-19 22:01:07

;;;随机云图线

[FONT=courier new](load "xyp_lib.vlx")
;;;随机云图线
(Defun C:test093 (/ ARC_DIST pte pts ptn)
(CMDLA0)
(MKLA "云图线" 100)
(setq NO1 (UREAL 1 "" "\n旋长" NO1)
rad (UREAL 1 "" "\n弧心角" 150)
pte (getpoint "\n选择云的起点 : ")
)
(if pte
(progn
(setq pts pte)
(Command "_.pline" pte "_a" "_a" rad)
)
)
(While pte
(setq scal (/ (sjs 200) 100.0))
(if (or (< scal 0.2) (> scal 1.8))
(setq scal 1)
)
(setq arc_dist (* NO1 scal)
ptn (GrRead 1)
READTYP (car ptn)
)
(if (or (= 5 READTYP) (= READTYP 3))
(progn
(setq ptn (cadr ptn))
(If (or (> (Distance pte ptn) ARC_DIST) (= READTYP 3))
(Progn
(Command ptn "_a" rad)
(Setq pte ptn)
)
)
(If (> (Distance pte ptn) (Distance pts ptn))
(Progn
(Command pts "_cl")
(Setq pte Nil)
)
)
)
)
)
(CMDLA1)
)[/FONT]

[FONT=courier new](load "xyp_lib.vlx") 
;;;随机云图线 
(Defun C:test093 (/ ARC_DIST pte pts ptn) 
  (CMDLA0) 
  (MKLA "云图线" 100) 
  (setq        NO1 (UREAL 1 "" "\n旋长" NO1) 
        rad (UREAL 1 "" "\n弧心角" 150) 
        pte (getpoint "\n选择云的起点 : ") 
  ) 
  (if pte 
    (progn 
      (setq pts pte) 
      (Command "_.pline" pte "_a" "_a" rad) 
    ) 
  ) 
  (While pte 
    (setq scal (/ (sjs 200) 100.0)) 
    (if        (or (< scal 0.2) (> scal 1.8)) 
      (setq scal 1) 
    ) 
    (setq arc_dist (* NO1 scal) 
          ptn           (GrRead 1) 
          READTYP  (car ptn) 
    ) 
    (if        (or (= 5 READTYP) (= READTYP 3)) 
      (progn 
        (setq ptn (cadr ptn)) 
        (If (or (> (Distance pte ptn) ARC_DIST) (= READTYP 3)) 
          (Progn 
            (Command ptn "_a" rad) 
            (Setq pte ptn) 
          ) 
        ) 
        (If (> (Distance pte ptn) (Distance pts ptn)) 
          (Progn 
            (Command pts "_cl") 
            (Setq pte Nil) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (CMDLA1) 
)[/FONT]

xyz518mm · 发表于 2005-11-20 19:05:49

又学到了不少东西
快来消化一下
谢谢了

yxpxa · 发表于 2005-11-21 00:24:27

其实，我也搞不懂这个函数，所以我就用一些现成的例子修改成自己的程序。
请问5楼的似水无痕，下面这个程序在运行时，如果使用了透明命令如pan，程序就退出了，应该怎么办？
(defun c:cs ()
  (command "text" (cadr (grread t 5 1)) "300" "0" "test") ;先生成文字
  (setq YH_textname (entlast))
  (while (= (car (setq YH_mouse (grread t 5 1))) 5)
(setq YH_gettext (entget YH_textname))
(setq YH_textpoint (cadr YH_mouse))
(setq YH_gettext
   (subst (cons 10 YH_textpoint) (assoc 10 YH_gettext) YH_gettext)
)(entmod YH_gettext)
  )
  (princ)
)

cy956 · 发表于 2005-11-21 02:22:53

grread函数也有一些不足的地方，就像上面提到的不能加入透明命令等等。
也有一些老lisper写过调用move或insert等cad命令来进行预演的程序，思路就是
预加入，拖动到合适区域（大小，角度等），然后删除预加物，再正式操作。

狂刀 · 发表于 2005-11-21 07:17:45

最初由 yxpxa 发布
[B]其实，我也搞不懂这个函数，所以我就用一些现成的例子修改成自己的程序。
请问5楼的似水无痕，下面这个程序在运行时，如果使用了透明命令如pan，程序就退出了，应该怎么办？
(defun c:cs ()
(command "text" (c... [/B]

改一下ｗｈｉｌｅ出口设置，比如用关键字

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：求教GRREAD的用法！斑竹教教我啊，eachy、xyp、aeo、wkai、狂刀.......

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子