2548572928 发表于 2024-4-3 11:24:34

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

;;;能否改为一次批量改相同直径圆；而不是一个一个改？？
;;源代码如下:
;;;改圆直径
(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 发表于 2024-4-3 13:26:38


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

ssyfeng 发表于 2024-4-3 11:59:14

试试这个：


Bao_lai 发表于 2024-4-3 12:24:00

vl-acad-defun

2548572928 发表于 2024-4-3 13:07:02

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

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

fan_zh 发表于 2024-4-3 13:21:14

看到一堆command就觉的头大

zwq8629 发表于 2024-4-3 14:30:36




wangsr 发表于 2024-4-3 15:13:02

不错谢谢分享。
页: [1]
查看完整版本: 大师们帮看下这个改圆直径程序