【组】组间移动实体

marting

1. (defun c:xdtb_grpmovent (/ nas ents e1 e2 na1 na2 ents)
   
2.   (xdrx-begin)
   
3.   (while (setq e1 (car (xdrx-entsel "\n拾取要移出的对象<结束>:")))
   
4.     (setq ents (cons e1 ents))
   
5.   )
   
6.   (if (and (setq e2 (car (xdrx-entsel "\n点取实体确定移动后的组<退出>:")))
   
7.            (setq na2 (XD::Entity:GroupName e2 nil))
   
8.       )
   
9.     (progn (mapcar '(lambda (x)
   
10.                       (if (setq na1 (XD::Entity:GroupName x nil))
    
11.                         (progn (setq nas (cons na1 nas))
    
12.                                (xdrx-group-removeentity (car na1) x)
    
13.                                (xdrx-group-appendentity (car na2) x)
    
14.                         )
    
15.                       )
    
16.                     )
    
17.                   (setq ents (xd::list:removedup ents))
    
18.            )
    
19.            (xdrx-prompt
    
20.              "\n已经将"
    
21.              (length ents)
    
22.              "个实体从组"
    
23.              (xdrx-string-join (xd::list:removedup nas) ",")
    
24.              "移动到组"
    
25.              na2
    
26.            )
    
27.     )
    
28.   )
    
29.   (xdrx-end)
    
30.   (princ)
    
31. )
    
32. 
    

(defun c:xdtb_grpmovent (/ nas ents e1 e2 na1 na2 ents)<br />   (xdrx-begin)<br />   (while (setq e1 (car (xdrx-entsel "\n拾取要移出的对象<结束>:")))<br />     (setq ents (cons e1 ents))<br />   )<br />   (if (and (setq e2 (car (xdrx-entsel "\n点取实体确定移动后的组<退出>:")))<br />            (setq na2 (XD::Entity:GroupName e2 nil))<br />       )<br />     (progn (mapcar '(lambda (x)<br />                       (if (setq na1 (XD::Entity:GroupName x nil))<br />                         (progn (setq nas (cons na1 nas))<br />                                (xdrx-group-removeentity (car na1) x)<br />                                (xdrx-group-appendentity (car na2) x)<br />                         )<br />                       )<br />                     )<br />                   (setq ents (xd::list:removedup ents))<br />            )<br />            (xdrx-prompt<br />              "\n已经将"<br />              (length ents)<br />              "个实体从组"<br />              (xdrx-string-join (xd::list:removedup nas) ",")<br />              "移动到组"<br />              na2<br />            )<br />     )<br />   )<br />   (xdrx-end)<br />   (princ)<br /> )<br /> <br />

yuren008

做个对论坛有益的人。