大师们帮看下这个改圆直径程序

2548572928

;;;能否改为一次批量改相同直径圆；而不是一个一个改？？
;;源代码如下:
;;;  改圆直径
(vl-acad-defun (defun c:cd (/ ss sslen en d nd d0 e o_err)
                 (setq ss (ssget (list '(-4 . "<OR") '(0 . "ARC") '
                                       (0 . "CIRCLE") '(-4 . "OR>")
                                 )
                          )
                 )
                 (if ss
                   (progn
                     (setq sslen (sslength ss))
                     (while (and
                              (> sslen 0)
                            )
                       (setq sslen (1- sslen))
                       (setq e (ssname ss sslen))
                       (setq en (entget e))
                       (setq d (* (cdr (assoc 40 en)) 2.0))
                       (command "-LAYER")
                       (command "U")
                       (command "*")
                       (command "")
                       (command "CHANGE")
                       (command e)
                       (command "")
                       (command "P")
                       (command "C")
                       (command 6)     ; 亮显颜色
                       (command "")
                       (redraw e 3)
                       (if (not d0)
                         (progn
                           (setq d0 d)
                         )
                       )
                       (princ "\n选择的圆直径为: ")
                       (princ d)
                       (setq pmt (strcat "\n输入新的直径 <" (rtos d0 2 4)
                                         ">:"
                                 )
                       )
                       (princ pmt)
                       (setq nd (getreal))
                       (if (not nd)
                         (progn
                           (setq nd d0)
                         )
                       )
                       (setq d0 nd)
                       (setq en (subst
                                  (cons 40 (/ nd 2.0))
                                  (assoc 40 en)
                                  en
                                )
                       )
                       (entmod en)
                       (if (not (assoc 62 en))
                         (progn
                           (command "CHANGE")
                           (command e)
                           (command "")
                           (command "P")
                           (command "C")
                           (command "BYLA")
                           (command "")
                         )
                       )
                     )
                   )
                   (progn
                     (princ "\n*** None found. ***")
                   )
                 )
                 (command ".UNDO" "E")
                 (setq *error* o_err)
                 (princ)
               )
)
'c:ccd

xyp1964

1. (defun c:tt ()
   
2.   (or rr (setq dd 100.))
   
3.   (setq rr (Ureal 7 "" "新的直径" rr))
   
4.   (princ "\n选择圆或圆弧<退出>: ")
   
5.   (if (setq ss (ssget '((0 . "ARC,CIRCLE"))))
   
6.     (xyp-SubUpd ss '(40 62) (list rr 6))
   
7.   )
   
8.   (princ)
   
9. )
   

(defun c:tt ()<br />   (or rr (setq dd 100.))<br />   (setq rr (Ureal 7 "" "新的直径" rr))<br />   (princ "\n选择圆或圆弧<退出>: ")<br />   (if (setq ss (ssget '((0 . "ARC,CIRCLE"))))<br />     (xyp-SubUpd ss '(40 62) (list rr 6))<br />   )<br />   (princ)<br /> )<br />

ssyfeng

试试这个：

Bao_lai

vl-acad-defun

2548572928

ssyfeng 发表于 2024-4-3 11:59
试试这个：

ssyfeng大师，你这个程序运行很好，但不是我想要的效果，还是表示感谢

fan_zh

看到一堆command就觉的头大

zwq8629

wangsr

不错谢谢分享。