【组】组间移动实体

marting · 发表于 2020-6-30 20:46:22

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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

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

yuren008 · 发表于 2020-7-2 09:35:52

做个对论坛有益的人。

既然青春留不住 · 发表于 2020-7-5 11:06:45

小康_U8y3Y · 发表于 2020-8-24 19:37:47

好东西大家多支持

feeling_chin · 发表于 2021-2-3 18:09:11

点赞点赞点赞！

ilovem · 发表于 2023-4-27 09:39:43

谢谢楼主的分享。

nsh935 · 发表于 2023-4-27 12:39:44

好东西支持

账号		自动登录	找回密码
密码			立即注册

[组管理] 【组】组间移动实体

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。