直径和数量很多，需要批量修改成不同的直径，如何修改这个程序？

75215195

这是自己弄的，本人是初学者，有点搞不明白这个程序。不明白错在哪里？
(defun c:pk ()
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setq s (ssget "x" '((0 . "CIRCLE"))))                                ;选所有的圆
  (setq a 0)                                                            ;大循环计数器
  (while (setq name (ssname s a))                                       ;大循环
    (setq en (entget name))
    (setq r (cdr (assoc 40 en)))
    (SETQ ss (ssget "x" (list '(0 . "CIRCLE")(cons 40 r))))             ;选相同半径的圆
    (setq i 0)                                                          ;第二循环
    (while (setq n (ssname ss i))                                             ；此改为（repeat (sslength ss) 还是出错。
    (setq ent (entget n))
    (setq ata (assoc 40 ent))
    (setq rr (cdr ata))
    (setq d (getreal (strcat "\n新直径<" (rtos (* rr 2) 2) ">:")))      ;输入新的直径
    (setq bta (cons 40 (* d 0.5)))
    (setq ent (subst bta ata ent))
    (entmod ent)
    (setq i (1+ i))                                   
    )                                                                   ;修改完成，回到大循环
    (setq a (1+ a))
          )
    (command "change" s "" "p" "la" "0" "")
    (princ "\n圆孔修改完成")
    (princ))

marting

把你的图压缩下附上来。没法测试。

Lisphk

楼主，你没说明你要做什么啊

看你的程序，两次循环， 在里面的循环里面，你交互输入半径，那如果圆很多，那执行起来中断的不是太多？

你第二次循环是想把 外面 相同的半径的 都修改成一样？ 如果这样，交互输入半径应该在第一次循环里面。

另外，你第二次循环修改的半径， 在外面循环还是要处理的，是不是修改完的半径就应该在选择集里面去掉（就是说，外面循环不在处理），不知道你明白我说的没。

75215195

Lisphk 发表于 2017-7-28 20:23

一个比如，A框中有不同直径的圆，每种相同直径的圆有几百个，运行程序后，批量修改A框中的圆直径，
修改直径3的改为3.5，完成此种圆修改后，继续修改下一种不同直径的圆，直至全部修改完毕。

Lisphk

75215195 发表于 2017-7-28 21:32

不知道我上面说的，你看明白没，从你的图说

你是从所有的圆循环

所以，你中间里面循环修改的圆，也是外面循环里面的圆，这就造成你修改过的，在外面循环又接着做。

所以，这个问题，你开始要把所有相同直径的圆分好组，大表里面每个小表里面是半径相同的圆。然后循环这个表，对里面小表在循环，就不会造成多次修改。

开源函数库有个通用的分组函数 xd::list:groupbyindex, 所以，你循环一次，把所有的圆和半径组成关联表，半径做关键字。 然后你按照半径分组。

1. (defun c:tt ()
   
2.   (if (setq ss (ssget "x" '((0 . "CIRCLE"))))
   
3.     (progn
   
4.       (setq i  -1
   
5.             el nil
   
6.       )
   
7.       (while (setq e (ssname ss (setq i (1+ i))))
   
8.         (setq r (cdr (assoc 40 (entget e)))
   
9.               el1 (list r e)
   
10.               el  (cons el1 el)
    
11.         )
    
12.       )
    
13.       (setq el (xd::list:groupbyindex el 0.1))
    
14.       ;; el为按半径分组的实体表
    
15.       (foreach n el
    
16.         (setq r          (car n)
    
17.               lst (cdr n)
    
18.                   ;; lst为半径相同的所有圆
    
19.         )
    
20.         (if (not (setq val (getreal (strcat "\n半径"
    
21.                                             (rtos r 2)
    
22.                                             "的圆半径修改为<"
    
23.                                             (rtos r 2)
    
24.                                             ">:"
    
25.                                     )
    
26.                            )
    
27.                  )
    
28.             )
    
29.           (setq val r)
    
30.         )
    
31.         (if (not (equal r val 0.01)) ;;半径改变了，进入修改
    
32.           (progn
    
33.             (mapcar '(lambda (x)
    
34.                        (setq ed         (entget x)
    
35.                              old (assoc 40 ed)
    
36.                              new (cons 40 val)
    
37.                              ed         (subst new old ed)
    
38.                        )
    
39.                        (entmod ed)
    
40.                      )
    
41.                     lst
    
42.             )
    
43.           )
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48.   (princ)
    
49. )

(defun c:tt ()<br />   (if (setq ss (ssget "x" '((0 . "CIRCLE"))))<br />     (progn<br />       (setq i  -1<br />             el nil<br />       )<br />       (while (setq e (ssname ss (setq i (1+ i))))<br />         (setq r (cdr (assoc 40 (entget e)))<br />               el1 (list r e)<br />               el  (cons el1 el)<br />         )<br />       )<br />       (setq el (xd::list:groupbyindex el 0.1))<br />       ;; el为按半径分组的实体表<br />       (foreach n el<br />         (setq r          (car n)<br />               lst (cdr n)<br />                   ;; lst为半径相同的所有圆<br />         )<br />         (if (not (setq val (getreal (strcat "\n半径"<br />                                             (rtos r 2)<br />                                             "的圆半径修改为<"<br />                                             (rtos r 2)<br />                                             ">:"<br />                                     )<br />                            )<br />                  )<br />             )<br />           (setq val r)<br />         )<br />         (if (not (equal r val 0.01)) ;;半径改变了，进入修改<br />           (progn<br />             (mapcar '(lambda (x)<br />                        (setq ed         (entget x)<br />                              old (assoc 40 ed)<br />                              new (cons 40 val)<br />                              ed         (subst new old ed)<br />                        )<br />                        (entmod ed)<br />                      )<br />                     lst<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

分组函数用 xd::list:groupbyindex 搜索论坛，拷贝回去。或者加载晓东通用LISP函数库就有了。


执行的时候，上面的分组后的变量 el 可能是这样的

1. 
   
2. 命令: !el
   
3. ((230.667 <图元名: -24dbd0> <图元名: -24dbd8> <图元名: -24dbe0> <图元名: -24dbe8>) (122.651
   
4. <图元名: -24dbb0> <图元名: -24dbb8> <图元名: -24dbc0> <图元名: -24dbc8>))
   
5. 
   

复制代码

75215195

Lisphk 发表于 2017-7-28 22:18

你说的我明白那个循环出错，谢谢你的帮助，修改一下你给出的程式，满足我的需求了！

kqqt6236

修改多个圆直径为相同直径，论坛有源码。

liunian0524

路过帮顶楼主