高手请进,求助
[指定圆批量替换半径]我想实现:敲入命令后,点取要被替换的圆(自动读取其半径,紧接着提示输入要的半径值,接着可框选对象,实现只将该半径的圆替换为输入的半径,而不改变其它半径的圆(而且不会修改圆弧,只修改圆)!
以下是[简易批量替换圆半径]的源码,请教高手,如果要改成具备上述功能的源码,应如何修改,先行谢过!!
(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)
)
首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面是我按你的要求写的程序，希望能帮到你！(defun c:cr()
(setq oldobj (entsel "\n请选择要改变半径的对象："))
(setq newrad (getreal"\n请输入新的半径值："))
(setq oldobjlst (entget (car oldobj)))
(setq oldrad (cdr (assoc '40 oldobjlst)))
(setq oldradlst (assoc '40 (entget (car oldobj))))
(setq ss (ssget (list '(0 . "circle") oldradlst)))
(setq n 0)
(repeat (sslength ss)
(setq ss_n (ssname ss n))
(setq ss_n_lst (entget ss_n))
(setq newradlst (cons 40 newrad))
(setq ss_n_lst (subst newradlst oldradlst ss_n_lst))
(entmod ss_n_lst)
(setq n (1+ n))
)
(princ)
) zyhandw 发表于 2011-10-20 10:50 static/image/common/back.gif
首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面 ...
非常感谢你，好东西啊!找了好久了。 zyhandw 发表于 2011-10-20 10:50 static/image/common/back.gif
首先声明俺也是菜鸟，不是高手！简单回答一下你的问题，其实不用这么多语句的程序，另写一个也不麻烦！下面 ...
楼主真的吗?你还说您是菜鸟,海,现在的高手都这般谦虚!在下真的实在佩服啊!!不多说了,先试下效果,万分感激溢于言表 大家共同探讨、进步！！
页:
[1]