grread做的一个递增复制，如何用GU版的替换掉

newbuser

小弟最近用grread做了个递增复制的lisp，根据Gu_xl版主的帖子想替换为gxl-Ge-grread带捕捉的函数，可不知怎样终止循环。下面我发上我自己的这个lisp，有精通该函数用法的高手，请深处您的援助之手。小弟不胜感激。

2. (defun c:mc ( )
   
3.    ;自定义新的出错函数
   
4.   (defun newerr  (msg)
   
5.     (mapcar 'eval sysvarlst)    ;恢复变量设置
   
6.     (if  *olderror*
   
7.       (setq *error*    *olderror*
   
8.       *olderror* nil
   
9.       )
   
10.     )          ;恢复*error*函数
    
11.     (if  (not
    
12.     (member msg '(nil "函数被取消" ";错误:quit / exit abort"))
    
13.   )
    
14.       (princ (strcat ";错误:" msg))
    
15.     )
    
16.   );;系统设置
    
17.   (command "undo" "be") ;;命令编组开始
    
18.   (setq
    
19.     sysvarlst (mapcar
    
20.     (function (lambda (n) (list 'setvar n (getvar n))))
    
21.     '("osmode"   "cmdecho"  "OSNAPCOORD"
    
22.       "dimzin"   "plinewid"  "TEXTSIZE"
    
23.       "textstyle"
    
24.      )
    
25.         )
    
26.   )                         ;;保存系统变量
    
27.   (setq *olderror* *error*) ;;保存出错函数
    
28.   (setq *error* newerr)     ;;设置自定义出错函数  
    
29.   (setvar "cmdecho" 0)      ;;关闭命令响应
    
30.   (setvar "OSNAPCOORD" 1)   ;;坐标数据优先级设为：键盘输入替代对象捕捉设置
    
31.   (setvar "OSMODE" 65)      ;;改变捕捉模式
    
32.   (setvar "dimzin" 0)       ;;不对主单位值作消零处理
    
33.   (setq el (entget (car (entsel "\n 请选择数字  >>"))))
    
34.   (setq  p0  (cdr (assoc 10 el))
    
35.   str (read (cdr (assoc 1 el)))
    
36.   h   (assoc 40 el)
    
37.   )
    
38.   (c:mf)
    
39.   (command "_undo" "_e")     ;;活动编组结束
    
40.   (mapcar 'eval sysvarlst)   ;;恢复变量设置
    
41.   (setq *error* *olderror*)  ;;恢复出错函数
    
42.   (princ)
    
43. 
    
44. (defun c:mf ()
    
45.   (if el
    
46.     (progn
    
47.       (entmake
    
48.   (list '(0 . "TEXT") (cons 1 (itoa (1+ str))) (cons 10 p0) h)
    
49.       )
    
50.       (setq lst (entget (entlast)))
    
51.       (setq loop T)
    
52.       (while loop
    
53.   (setq code (grread T 8)
    
54.         mod  (car code)
    
55.         val  (cadr code)
    
56.   )
    
57.   (cond ((= mod 5)
    
58.          (setq p0 val)
    
59.          (setq lst (subst (cons 10 p0) (assoc 10 lst) lst))
    
60.          (entmod lst)
    
61.          (setq str (read (cdr (assoc 1 lst))))
    
62.         )
    
63.         ((= mod 3) (c:mf))                              ;;左击鼠标从c:mf继续循环
    
64.         ((= mod 25) (setq loop nil) (entdel (entlast))) ;;右击鼠标(本电脑值为25)，删除最后生成的数字编号，结束操作
    
65.   )
    
66.       )
    
67.     )
    
68.   )
    
69. )
    
70. )

(defun c:mc ( )<br />    ;自定义新的出错函数<br />   (defun newerr  (msg)<br />     (mapcar 'eval sysvarlst)    ;恢复变量设置<br />     (if  *olderror*<br />       (setq *error*    *olderror*<br />       *olderror* nil<br />       )<br />     )          ;恢复*error*函数<br />     (if  (not<br />     (member msg '(nil "函数被取消" ";错误:quit / exit abort"))<br />   )<br />       (princ (strcat ";错误:" msg))<br />     )<br />   );;系统设置<br />   (command "undo" "be") ;;命令编组开始<br />   (setq<br />     sysvarlst (mapcar<br />     (function (lambda (n) (list 'setvar n (getvar n))))<br />     '("osmode"   "cmdecho"  "OSNAPCOORD"<br />       "dimzin"   "plinewid"  "TEXTSIZE"<br />       "textstyle"<br />      )<br />         )<br />   )                         ;;保存系统变量<br />   (setq *olderror* *error*) ;;保存出错函数<br />   (setq *error* newerr)     ;;设置自定义出错函数  <br />   (setvar "cmdecho" 0)      ;;关闭命令响应<br />   (setvar "OSNAPCOORD" 1)   ;;坐标数据优先级设为：键盘输入替代对象捕捉设置<br />   (setvar "OSMODE" 65)      ;;改变捕捉模式<br />   (setvar "dimzin" 0)       ;;不对主单位值作消零处理<br />   (setq el (entget (car (entsel "\n 请选择数字  >>"))))<br />   (setq  p0  (cdr (assoc 10 el))<br />   str (read (cdr (assoc 1 el)))<br />   h   (assoc 40 el)<br />   )<br />   (c:mf)<br />   (command "_undo" "_e")     ;;活动编组结束<br />   (mapcar 'eval sysvarlst)   ;;恢复变量设置<br />   (setq *error* *olderror*)  ;;恢复出错函数<br />   (princ)<br /> <br /> (defun c:mf ()<br />   (if el<br />     (progn<br />       (entmake<br />   (list '(0 . "TEXT") (cons 1 (itoa (1+ str))) (cons 10 p0) h)<br />       )<br />       (setq lst (entget (entlast)))<br />       (setq loop T)<br />       (while loop<br />   (setq code (grread T 8)<br />         mod  (car code)<br />         val  (cadr code)<br />   )<br />   (cond ((= mod 5)<br />          (setq p0 val)<br />          (setq lst (subst (cons 10 p0) (assoc 10 lst) lst))<br />          (entmod lst)<br />          (setq str (read (cdr (assoc 1 lst))))<br />         )<br />         ((= mod 3) (c:mf))                              ;;左击鼠标从c:mf继续循环<br />         ((= mod 25) (setq loop nil) (entdel (entlast))) ;;右击鼠标(本电脑值为25)，删除最后生成的数字编号，结束操作<br />   )<br />       )<br />     )<br />   )<br /> )<br /> )

Andyhon

      (setq loop T)
      (while loop ....)

您得对 Loop 变量做条件式 ==> nil
那么当 (while Loop  ==> (while nil   <== 退出

newbuser

Andyhon 发表于 2015-1-3 11:36
(setq loop T)
      (while loop ....)

我看gu版在带捕捉的grread自定义函数帖子里说，直接替换掉grread效果一样，我替换完了，结果不循环。

newbuser

自己顶一下，希望有此经验之人给小解一下gxl-Ge-grread函数的详细用法。

鱼与熊掌

..他的函数说明写的挺详细的.

newbuser

鱼与熊掌 发表于 2015-1-3 16:54
..他的函数说明写的挺详细的.

是啊，他的使用说明里说用gxl-Ge-grread代替grread即可实现带捕捉功能，可我替换完之后，就不能循环复制了呢？麻烦熊掌大哥看下我的那个小程序，是不是循环部分有问题。

鱼与熊掌

(while (progn
  (setq gr(gxl-grread ~~~))
  (setq a(car gr) b(cadr gr))
  (cons((= a 5)
                t)
  (t nil)
)
)

newbuser

鱼与熊掌 发表于 2015-1-3 17:44
(while (progn
  (setq gr(gxl-grread ~~~))
  (setq a(car gr) b(cadr gr))

我将原程序中的一句做了如下改动，(grread T 8)==>>(gxl-Ge-grread '(T 7 3) p0 e)，可打开的捕捉只有端点和插入点的捕捉，没有测试程序中的最近点，垂足点等其他点的捕捉。并且在鼠标移动过程中，整个效果就跟打开了“捕捉”效果一样，请注意是捕捉，不是对象捕捉。按键“F3”后，关闭捕捉，运行很流畅，具体效果如下图所示，还望兄长阁下明示。

鱼与熊掌

newbuser 发表于 2015-1-4 10:48
我将原程序中的一句做了如下改动，(grread T 8)==>>(gxl-Ge-grread '(T 7 3) p0 e)，可打开的捕捉只有端点 ...

因为你字也一起捕捉了，所以会这样，g版的代码不是有对ss不捕捉吗，你看看

newbuser

鱼与熊掌 发表于 2015-1-4 10:58
因为你字也一起捕捉了，所以会这样，g版的代码不是有对ss不捕捉吗，你看看

我按你的方法改进了下，运行倒是流畅了，可，仍然只有端点和插入点的捕捉啊。另外，你说的Gu版避开选择集捕捉跟我这个单独的text图元有些不符。代码我发上来，麻烦您老费心看下到底是哪里出的问题。

2. (defun c:mc ()
   
3.                                         ;自定义新的出错函数
   
4.   (defun newerr        (msg)
   
5.     (mapcar 'eval sysvarlst)                ;恢复变量设置
   
6.     (if        *olderror*
   
7.       (setq *error*    *olderror*
   
8.             *olderror* nil
   
9.       )
   
10.     )                                        ;恢复*error*函数
    
11.     (if        (not
    
12.           (member msg '(nil "函数被取消" ";错误:quit / exit abort"))
    
13.         )
    
14.       (princ (strcat ";错误:" msg))
    
15.     )
    
16.   )
    
17.   ;;系统设置
    
18.   (command "undo" "be")
    
19.   ;;命令编组开始
    
20.   (setq
    
21.     sysvarlst (mapcar
    
22.                 (function (lambda (n) (list 'setvar n (getvar n))))
    
23.                 '("osmode"         "cmdecho"        "OSNAPCOORD"
    
24.                   "dimzin"         "plinewid"        "TEXTSIZE"
    
25.                   "textstyle"
    
26.                  )
    
27.               )
    
28.   )
    
29.   ;;保存系统变量
    
30.   (setq *olderror* *error*)
    
31.   ;;保存出错函数
    
32.   (setq *error* newerr)
    
33.   ;;设置自定义出错函数  
    
34.   (setvar "cmdecho" 0)
    
35.   ;;关闭命令响应
    
36.   (setvar "OSNAPCOORD" 1)
    
37.   ;;坐标数据优先级设为：键盘输入替代对象捕捉设置
    
38.   (setvar "OSMODE" 65)
    
39.   ;;改变捕捉模式
    
40.   (setvar "dimzin" 0)
    
41.   ;;不对主单位值作消零处理
    
42.   (setq el (entget (car (entsel "\n 请选择数字  >>"))))
    
43.   (setq        p0  (cdr (assoc 10 el))
    
44.         str (read (cdr (assoc 1 el)))
    
45.         h   (assoc 40 el)
    
46.   )
    
47.   (c:mf)
    
48.   (command "_undo" "_e")
    
49.   ;;活动编组结束
    
50.   (mapcar 'eval sysvarlst)
    
51.   ;;恢复变量设置
    
52.   (setq *error* *olderror*)
    
53.   ;;恢复出错函数
    
54.   (princ)
    
55. )
    
56. (defun c:mf ()
    
57.   (entmake
    
58.     (list '(0 . "TEXT") (cons 1 (itoa (1+ str))) (cons 10 p0) h)
    
59.   )
    
60.   (setq lst (entget (setq en (entlast))))
    
61.   (setq loop T)
    
62.   (while loop
    
63.     (progn
    
64.       (setq code (gxl-Ge-grread '(T 7 3) p0 en)
    
65.             mod         (car code)
    
66.             val         (cadr code)
    
67.       )
    
68.     )
    
69.     (cond ((= mod 5)
    
70.            (setq p0 val)
    
71.            (setq lst (subst (cons 10 p0) (assoc 10 lst) lst))
    
72.            (entmod lst)
    
73.            (setq str (read (cdr (assoc 1 lst))))
    
74.           )
    
75.           ((= mod 3) (c:mf))
    
76.           ((or (= mod 32) (= mod 25))
    
77.            (setq loop nil)
    
78.            (entdel (entlast))
    
79.           )
    
80.     )
    
81.   )
    
82. )

(defun c:mc ()<br />                                         ;自定义新的出错函数<br />   (defun newerr        (msg)<br />     (mapcar 'eval sysvarlst)                ;恢复变量设置<br />     (if        *olderror*<br />       (setq *error*    *olderror*<br />             *olderror* nil<br />       )<br />     )                                        ;恢复*error*函数<br />     (if        (not<br />           (member msg '(nil "函数被取消" ";错误:quit / exit abort"))<br />         )<br />       (princ (strcat ";错误:" msg))<br />     )<br />   )<br />   ;;系统设置<br />   (command "undo" "be")<br />   ;;命令编组开始<br />   (setq<br />     sysvarlst (mapcar<br />                 (function (lambda (n) (list 'setvar n (getvar n))))<br />                 '("osmode"         "cmdecho"        "OSNAPCOORD"<br />                   "dimzin"         "plinewid"        "TEXTSIZE"<br />                   "textstyle"<br />                  )<br />               )<br />   )<br />   ;;保存系统变量<br />   (setq *olderror* *error*)<br />   ;;保存出错函数<br />   (setq *error* newerr)<br />   ;;设置自定义出错函数  <br />   (setvar "cmdecho" 0)<br />   ;;关闭命令响应<br />   (setvar "OSNAPCOORD" 1)<br />   ;;坐标数据优先级设为：键盘输入替代对象捕捉设置<br />   (setvar "OSMODE" 65)<br />   ;;改变捕捉模式<br />   (setvar "dimzin" 0)<br />   ;;不对主单位值作消零处理<br />   (setq el (entget (car (entsel "\n 请选择数字  >>"))))<br />   (setq        p0  (cdr (assoc 10 el))<br />         str (read (cdr (assoc 1 el)))<br />         h   (assoc 40 el)<br />   )<br />   (c:mf)<br />   (command "_undo" "_e")<br />   ;;活动编组结束<br />   (mapcar 'eval sysvarlst)<br />   ;;恢复变量设置<br />   (setq *error* *olderror*)<br />   ;;恢复出错函数<br />   (princ)<br /> )<br /> (defun c:mf ()<br />   (entmake<br />     (list '(0 . "TEXT") (cons 1 (itoa (1+ str))) (cons 10 p0) h)<br />   )<br />   (setq lst (entget (setq en (entlast))))<br />   (setq loop T)<br />   (while loop<br />     (progn<br />       (setq code (gxl-Ge-grread '(T 7 3) p0 en)<br />             mod         (car code)<br />             val         (cadr code)<br />       )<br />     )<br />     (cond ((= mod 5)<br />            (setq p0 val)<br />            (setq lst (subst (cons 10 p0) (assoc 10 lst) lst))<br />            (entmod lst)<br />            (setq str (read (cdr (assoc 1 lst))))<br />           )<br />           ((= mod 3) (c:mf))<br />           ((or (= mod 32) (= mod 25))<br />            (setq loop nil)<br />            (entdel (entlast))<br />           )<br />     )<br />   )<br /> )