[弹指神通]：批量修改圆的半径

huaheroys

我写了一个批量修改圆半径的程序,可是有点问题,劳烦各位大侠指点一二.
(defun C:PJ()
(setq new_rad (getreal "请输入新的半径："))
  (prompt "\n选择：")
  (setq ss (ssget))
  
  (setq n 0)
  (setq k 0)
  
  (repeat (sslength ss)
      (setq en (ssname ss n))
      (setq endata (entget en))
      (setq entype (cdr (assoc 0 endata)))
   
      (if (= entype "CIRCLE")
        (sub_upd_rad)
        )
      (setq n (1 + n))
   )
  (prin1)
)

  (defun sub_upd_rad()
  (setq 40_list (assoc 40 endata))
  (setq new_40_list (cons 40 new_rad))
  (setq endata (subst new_40_list 40_list endata))
  (entmod endata)
    )

  (prompt "\n ***** <<PJ>> ***** 更新圆半径")
  (prin1)

xyp1964

2. [FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20051204 (1764)
   
3. ;|加载通用函数(可在签名栏直接下载)
   
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
6. ★1·在acad.lsp中增加(load"xyp_lib")
   
7. ■2·在每个程序内增加(load"xyp_lib")
   
8. ■3·在command下，输入(load"xyp_lib")
   
9. ■4·在菜单.mnl中增加(load"xyp_lib")
   
10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
11. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
13. |;
    
14. ;
    
15. (defun c:test ()
    
16.   (CMDLA0)
    
17.   (if (null rad)
    
18.     (setq rad 100)
    
19.   )
    
20.   (setq        rad (UREAL 7 "" "\n新半径" rad)
    
21.         ss  (ssget '((0 . "CIRCLE")))
    
22.         i   -1
    
23.   )
    
24.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
25.     (sub_upd s1 40 rad)
    
26.   )
    
27.   (CMDLA1)
    
28. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20051204 (1764)<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> ;<br /> (defun c:test ()<br />   (CMDLA0)<br />   (if (null rad)<br />     (setq rad 100)<br />   )<br />   (setq        rad (UREAL 7 "" "\n新半径" rad)<br />         ss  (ssget '((0 . "CIRCLE")))<br />         i   -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (sub_upd s1 40 rad)<br />   )<br />   (CMDLA1)<br /> )[/FONT]

huaheroys

等了这么久,看来只有大侠你是我的知音了
我欠你太多了,没办法还要继续欠下去
大哥:以下三个子程序是啥意思啊!
(CMDLA0)
(CMDLA1)

还有
(setq rad (UREAL 7 "" "\n新半径" rad)     "UREAL"

我想学习LISP,可是看不懂你的源代码,或者把我有问题的源代码改一下,求你了,这个问题捆扰我好多天了!

xyp1964

2. [FONT=courier new](defun C:PJ (/ ss n s1)
   
3.   (prompt "\n选择 : ")
   
4.   (setq        ss  (ssget '((0 . "CIRCLE")))
   
5.         rad (getreal "请输入新的半径 : ")
   
6.         n   -1
   
7.   )
   
8.   (if ss
   
9.     (progn
   
10.       (repeat (sslength ss)
    
11.         (setq s1 (ssname ss (setq n (1+ n))))
    
12.         (sub_upd s1 40 rad)
    
13.       )
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )
    
18. (defun sub_upd (ename code newvalue)
    
19.   (entmod (subst (cons code newvalue)
    
20.                  (assoc code (entget ename))
    
21.                  (entget ename)
    
22.           )
    
23.   )
    
24.   (entupd ename)
    
25. )
    
26. 
    
27. (prompt "\n ***** <> ***** 更新圆半径")
    
28. (princ)[/FONT]

[FONT=courier new](defun C:PJ (/ ss n s1)<br />   (prompt "\n选择 : ")<br />   (setq        ss  (ssget '((0 . "CIRCLE")))<br />         rad (getreal "请输入新的半径 : ")<br />         n   -1<br />   )<br />   (if ss<br />     (progn<br />       (repeat (sslength ss)<br />         (setq s1 (ssname ss (setq n (1+ n))))<br />         (sub_upd s1 40 rad)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> (defun sub_upd (ename code newvalue)<br />   (entmod (subst (cons code newvalue)<br />                  (assoc code (entget ename))<br />                  (entget ename)<br />           )<br />   )<br />   (entupd ename)<br /> )<br /> <br /> (prompt "\n ***** <> ***** 更新圆半径")<br /> (princ)[/FONT]

huaheroys

xyp1964师傅:
终于搞懂了,太感谢了,
以后你就是我的师傅了,有机会\有条件的话来个拜师仪式.

(defun C:PJ (/ ss n s1)
  (prompt "\n选择 : ")
  (setq        ss  (ssget '((0 . "CIRCLE")))
        rad (getreal "请输入新的半径 : ")
        n   -1
  )
  (if (/= ss nil)
    (progn
      (repeat (sslength ss)
              (setq s1 (ssname ss (setq n (1+ n))))
              (sub_upd s1 40 rad)
      )
    )
  )
  (princ)
)
;用新值替换旧值（对象、群码、新值）
(defun sub_upd (ename code newvalue)
  (entmod (subst (cons code newvalue) (assoc code (entget ename))(entget ename)))（新半径子列表、原半径子列表、对象属性列表）
  (entupd ename)
)

(prompt "\n ***** <PJ> ***** 更新圆半径")
(princ)