[求助]：编了一半出现问题。解决不来~！！

carrot1983

;本来这个程序的运行过程是：
第一次如果选中数字"1"，然后选择复制第一个数字“1”的基点pt_base（这个基点跟第一个数字的（10的值）是有一定相对距离的），然后就跟多重复制有点像，以pt_base为基点，复制出其它的数字都是以txt_add为增值的。（用这个来标楼梯台阶数，哈：））
可是我现在只是在同一个位置累加。怎么办？哪位帮我提点建议吧。

2. 
   
3.   [FONT=courier new]
   
4. ;********************************数字递增复制add
   
5. (defun C:add()
   
6.     (setq sel (entsel "\n选择TEXT文本:"))
   
7.   (if (= nil sel)
   
8.     (progn
   
9.       (princ "\n>>error!")
   
10.       (exit)
    
11.   ));  end if
    
12. 
    
13.   (setq ss (ssadd))         
    
14.   (setq na (car sel)) ;取得选到的图元的图元名。
    
15.   (ssadd na ss)       
    
16.   (setq txt_add (getint "\n请输入增值(默认为1):"))
    
17.   (if (= nil txt_add) (setq txt_add 1))
    
18.   (setq pt_base (getpoint "\n基准点:"))
    
19.       
    
20.   (setq k 1)
    
21.   (while (= k 1)
    
22.           (setq pt_to (getpoint "\n拷贝至(点回车退出):"))
    
23.           (setq ss_new (ssadd))
    
24.           (command "copy" ss_new"" "m" pt_base pt_to)
    
25.           (ssadd (entlast) ss_new)
    
26.           (setq txt_name (ssname ss_new 0))
    
27.           (setq txt_data (entget txt_name))
    
28.           (setq txt_txt (cdr (assoc '1 txt_data)))
    
29.           (setq faq1 (atoi txt_txt))
    
30.           (setq faq2 (itoa (+ faq1 txt_add)))
    
31.           (setq txt_data (subst (cons 1 faq2) (assoc '1 txt_data) txt_data))
    
32.           (entmod txt_data)
    
33.          
    
34.   );end while
    
35.   (prin1)
    
36. )
    
37.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;********************************数字递增复制add<br /> (defun C:add()<br />     (setq sel (entsel "\n选择TEXT文本:"))<br />   (if (= nil sel)<br />     (progn<br />       (princ "\n>>error!")<br />       (exit)<br />   ));  end if<br /> <br />   (setq ss (ssadd))         <br />   (setq na (car sel)) ;取得选到的图元的图元名。<br />   (ssadd na ss)        <br />   (setq txt_add (getint "\n请输入增值(默认为1):"))<br />   (if (= nil txt_add) (setq txt_add 1))<br />   (setq pt_base (getpoint "\n基准点:"))<br />        <br />   (setq k 1)<br />   (while (= k 1)<br />           (setq pt_to (getpoint "\n拷贝至(点回车退出):"))<br />           (setq ss_new (ssadd))<br />           (command "copy" ss_new"" "m" pt_base pt_to)<br />           (ssadd (entlast) ss_new)<br />           (setq txt_name (ssname ss_new 0))<br />           (setq txt_data (entget txt_name))<br />           (setq txt_txt (cdr (assoc '1 txt_data)))<br />           (setq faq1 (atoi txt_txt))<br />           (setq faq2 (itoa (+ faq1 txt_add)))<br />           (setq txt_data (subst (cons 1 faq2) (assoc '1 txt_data) txt_data))<br />           (entmod txt_data)<br />           <br />   );end while<br />   (prin1)<br /> )<br />   [/FONT]<br />

Underway

2. 
   
3. 
   
4. (defun C:add ()
   
5.   (cond
   
6.     ((null (setq sel (entsel "\n选择TEXT文本:"))))
   
7.     (T
   
8.      (setq ss (ssadd))
   
9.      (setq na (car sel))                ;取得选到的图元的图元名。
   
10.      (setq txt_add (getint "\n请输入增值(默认为1):"))
    
11.      (setq txt_txt (cdr (assoc '1 (entget na))))
    
12.      (setq faq1 (atoi txt_txt))
    
13.      (if (= nil txt_add)
    
14.        (setq txt_add 1)
    
15.      )
    
16.      (setq pt_base (getpoint "\n基准点:")
    
17.                idx 1
    
18.      )
    
19.      (while (setq pt_to (getpoint "\n拷贝至(点回车退出):"))
    
20.        (command "copy" na "" pt_base pt_to)
    
21.        (setq txt_data (entget (entlast)))
    
22.        (setq faq2 (itoa (+ faq1 (* txt_add idx))))
    
23.        (setq
    
24.          txt_data (subst (cons 1 faq2) (assoc '1 txt_data) txt_data)
    
25.        )
    
26.        (entmod txt_data)
    
27.        (setq idx (1+ idx))
    
28.      )        ;end while
    
29.     )                               
    
30.   )
    
31.   (prin1)
    
32. )

<br /> <br /> (defun C:add ()<br />   (cond<br />     ((null (setq sel (entsel "\n选择TEXT文本:"))))<br />     (T<br />      (setq ss (ssadd))<br />      (setq na (car sel))                ;取得选到的图元的图元名。<br />      (setq txt_add (getint "\n请输入增值(默认为1):"))<br />      (setq txt_txt (cdr (assoc '1 (entget na))))<br />      (setq faq1 (atoi txt_txt))<br />      (if (= nil txt_add)<br />        (setq txt_add 1)<br />      )<br />      (setq pt_base (getpoint "\n基准点:")<br />                idx 1<br />      )<br />      (while (setq pt_to (getpoint "\n拷贝至(点回车退出):"))<br />        (command "copy" na "" pt_base pt_to)<br />        (setq txt_data (entget (entlast)))<br />        (setq faq2 (itoa (+ faq1 (* txt_add idx))))<br />        (setq<br />          txt_data (subst (cons 1 faq2) (assoc '1 txt_data) txt_data)<br />        )<br />        (entmod txt_data)<br />        (setq idx (1+ idx))<br />      )        ;end while<br />     )                                <br />   )<br />   (prin1)<br /> )

carrot1983

感谢楼上。还没去试，cond我不太会用。呵。现在只会用if 和while的一点皮毛。呵。考回去好好学习学习。

xyp1964

2. [FONT=courier new];;;数字文本递增复制
   
3. (defun C:test ()
   
4.   (cmdla0)
   
5.   (if (null INT)
   
6.     (setq INT 1)
   
7.   )
   
8.   (if (setq na (car (entsel "\n选择TEXT文本<退出>: ")))
   
9.     (if        (= (xyp-get-dxf 0 na) "TEXT")
   
10.       (progn
    
11.         (setq INT (UINT 1 "" "请输入增值" INT)
    
12.               faq (atoi (xyp-get-dxf 1 na))
    
13.               PT0 (getpoint "\n基准点: ")
    
14.         )
    
15.         (while (setq PT1 (getpoint PT0 "\n拷贝至<退出>: "))
    
16.           (command "copy" na "" PT0 PT1)
    
17.           (setq        s1  (entlast)
    
18.                 faq (+ faq INT)
    
19.                 tx  (itoa faq)
    
20.           )
    
21.           (xyp-SUBUPD s1 1 tx)
    
22.         )
    
23.       )
    
24.       (princ"\n所选非文本!")
    
25.     )
    
26.   )
    
27.   (cmdla1)
    
28. )[/FONT]

[FONT=courier new];;;数字文本递增复制<br /> (defun C:test ()<br />   (cmdla0)<br />   (if (null INT)<br />     (setq INT 1)<br />   )<br />   (if (setq na (car (entsel "\n选择TEXT文本<退出>: ")))<br />     (if        (= (xyp-get-dxf 0 na) "TEXT")<br />       (progn<br />         (setq INT (UINT 1 "" "请输入增值" INT)<br />               faq (atoi (xyp-get-dxf 1 na))<br />               PT0 (getpoint "\n基准点: ")<br />         )<br />         (while (setq PT1 (getpoint PT0 "\n拷贝至<退出>: "))<br />           (command "copy" na "" PT0 PT1)<br />           (setq        s1  (entlast)<br />                 faq (+ faq INT)<br />                 tx  (itoa faq)<br />           )<br />           (xyp-SUBUPD s1 1 tx)<br />         )<br />       )<br />       (princ"\n所选非文本!")<br />     )<br />   )<br />   (cmdla1)<br /> )[/FONT]

carrot1983

把厉害啊，把一个程序精简得很帅。
激动之情不知道怎么表达啦。哈哈~~~

错误: no function definition: CMDLA0
错误: no function definition: XYP-GET-DXF

我不懂为什么会这样。呵，心里有点明白，就是不理解没有在lisp里的副函式里定义的命令能用吗？
(顺便问一下vl-***的lisp命令可以在r14下用吗？有点菜~~)

ynj

这个问题我来给你解决。