高手请进,求助

aaacjh

[指定圆批量替换半径]
我想实现:敲入命令后,点取要被替换的圆(自动读取其半径,紧接着提示输入要的半径值,接着可框选对象,实现只将该半径的圆替换为输入的半径,而不改变其它半径的圆(而且不会修改圆弧,只修改圆)!
以下是[简易批量替换圆半径]的源码,请教高手,如果要改成具备上述功能的源码,应如何修改,先行谢过!!
(Defun c:cr ()
(command "redraw")
(command "undo" "begin")
(setq pbx (getvar "pickbox"))
(setvar "pickbox" 3)
(setq ucsfl (getvar "ucsfollow"))
(setvar "ucsfollow" 0)
(command "ucs" "world")   ;转到世界坐标系
( setq R (getreal "\ninput R ")) ；输入圆半径
(setq fil (ssget))   ；选择圆
(setq len (sslength fil))  ；确定选中圆的个数
(setq n 0)
(while (<= n (- len 1))
  (progn
   (setq e (ssname fil n))
   (setq ed (entget e))
   (setq b nil) (setq c nil)
   (if (/= "CIRCLE" (cdr (assoc 0 ed)))
    (setq n (+ 1 n))
    (progn
     (setq R0 (cdr (assoc 40 ed))) ;old circle's radius
     (setq pt0 (cdr (assoc 10 ed))) ;old circle's center
     (setq ed (subst (cons 40 R) (assoc 40 ed) ed))
     (setq n (+ 1 n))
     (entmod ed)
(command "zoom" "c" pt0 "15")  ;可调整该数字以适应不同半径的圆
     (setq ang 0)
     (while (< ang (* 2 pi))
      (setq pt1 (polar pt0 ang R0))
      (setq ang (+ ang (/ pi 30)))
      (setq pt2 (osnap pt1 "endp"))
      (setq b (cons pt2 b))
     )
(setq ln (length b))
(setq lnn (- ln 1))
(setq i 0)
(setq pt (nth i b))
(while (<= i lnn)
  (setq pt (nth i b))
  (setq j (+ i 1))
  (setq jt (nth j b))
  (while (and (not (equal pt jt)) (< j lnn))
    (setq qt (nth j b))
    (setq j (+ 1 j))
    (setq jt (nth j b))
  )
  (if (not (equal pt jt)) (setq c (cons pt c)))
  (setq i (+ 1 i))
)
  (setq k 0)
  (setq L (length c))
;*************************************
  (while (<= k (- L 1))
    (setq pt (nth k c))
       (if (> R0 R)
          (command "extend" e "" pt "")
          (command "trim" e "" pt "")
       )
    (setq k (+ 1 k))
   )；while结束
;*************************************
  )
)
    )
   )
(command "ucs" "p")   ;返回用户坐标系
(setvar "ucsfollow" ucsfl)
(setvar "pickbox" pbx)
(command "undo" "end")
(princ)      
  
)

zyhandw

首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面是我按你的要求写的程序，希望能帮到你！

2. (defun c:cr()
   
3.   (setq oldobj (entsel "\n请选择要改变半径的对象："))
   
4.   (setq newrad (getreal"\n请输入新的半径值："))
   
5.   (setq oldobjlst (entget (car oldobj)))
   
6.   (setq oldrad (cdr (assoc '40 oldobjlst)))
   
7.   (setq oldradlst (assoc '40 (entget (car oldobj))))
   
8.   (setq ss (ssget (list '(0 . "circle") oldradlst)))
   
9.   (setq n 0)
   
10.   (repeat (sslength ss)
    
11.     (setq ss_n (ssname ss n))
    
12.     (setq ss_n_lst (entget ss_n))
    
13.     (setq newradlst (cons 40 newrad))
    
14.     (setq ss_n_lst (subst newradlst oldradlst ss_n_lst))
    
15.     (entmod ss_n_lst)
    
16.     (setq n (1+ n))
    
17.   )
    
18.   (princ)
    
19. )

(defun c:cr()<br />   (setq oldobj (entsel "\n请选择要改变半径的对象："))<br />   (setq newrad (getreal"\n请输入新的半径值："))<br />   (setq oldobjlst (entget (car oldobj)))<br />   (setq oldrad (cdr (assoc '40 oldobjlst)))<br />   (setq oldradlst (assoc '40 (entget (car oldobj))))<br />   (setq ss (ssget (list '(0 . "circle") oldradlst)))<br />   (setq n 0)<br />   (repeat (sslength ss)<br />     (setq ss_n (ssname ss n))<br />     (setq ss_n_lst (entget ss_n))<br />     (setq newradlst (cons 40 newrad))<br />     (setq ss_n_lst (subst newradlst oldradlst ss_n_lst))<br />     (entmod ss_n_lst)<br />     (setq n (1+ n))<br />   )<br />   (princ)<br /> )

czykx613

zyhandw 发表于 2011-10-20 10:50
首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面 ...

非常感谢你，好东西啊!找了好久了。

aaacjh

zyhandw 发表于 2011-10-20 10:50
首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面 ...

楼主真的吗?你还说您是菜鸟,海,现在的高手都这般谦虚!在下真的实在佩服啊!!不多说了,先试下效果,万分感激溢于言表

zyhandw

大家共同探讨、进步！！