这是论坛里单行文字交换的源码，请哪位可以改进一下

小灰345 · 发表于 2014-7-12 06:54:03

(defun C:JH (/ a b a1 b1)
  (setq a (entget (car (entsel "\n选择第一个文本"))))
  (setq b (entget (car (entsel "\n选择第二个文本"))))
  (setq a1 (cdr (assoc 1 a)))
  (setq b1 (cdr (assoc 1 b)))
  (setq       a (SUBST (cons 1 b1)
               (ASSOC 1 a)
               a
      )
  )
  (setq       b (SUBST (cons 1 a1)
               (ASSOC 1 b)
               b
      )
  )
  (ENTMOD a)
  (ENTMOD b)
(princ)
)
这个是论坛里收集的文字交换源码，请哪位大神能够修改成块属性之间，块属性和文字，可以相互交换，谢谢了！
在此感谢原作者的无私奉献！

ZZXXQQ · 发表于 2014-7-12 08:28:59

本帖最后由 ZZXXQQ 于 2014-7-12 08:32 编辑

(defun C:JH (/ a b a1 b1 a2 b2)
(if (and (setq a (nentsel "\n选择第一个文本"))
(setq b (nentsel "\n选择第二个文本"))) (progn
(setq a2 (ssget (cadr a)))
(setq b2 (ssget (cadr b)))
(setq a (entget (car a)))
(setq b (entget (car b)))
(setq a1 (cdr (assoc 1 a)))
(setq b1 (cdr (assoc 1 b)))
(entmod (subst (cons 1 b1) (assoc 1 a) a))
(entmod (subst (cons 1 a1) (assoc 1 b) b))
(if (= (cdr(assoc 0 (entget(setq a1 (ssname a2 0))))) "INSERT")
(entupd a1)
)
(if (= (cdr(assoc 0 (entget(setq a1 (ssname b2 0))))) "INSERT")
(entupd a1)
)
))
(princ)
)

小灰345 · 发表于 2014-7-12 12:07:35

ZZXXQQ 发表于 2014-7-12 08:28

谢谢，收藏了！

sunnylhj · 发表于 2014-7-12 20:17:16

这个是好东西！！

friendship · 发表于 2014-7-12 21:54:00

ZZXXQQ 发表于 2014-7-12 08:28

版主，你好，可以弄成带循环的吗？完成第一次交换后，先不退出程序，直接交换下一组文字，下2组，等等

xyp1964 · 发表于 2014-7-12 22:40:39

(defun c:tt ()
(while (and (setq a (nentsel "\n选择第一个文本: "))
(setq b (nentsel "\n选择第二个文本: "))
)
(setq s1 (car a)
s2 (car b)
t1 (xyp-DXF 1 s1)
t2 (xyp-DXF 1 s2)
s1 (xyp-SubUpd s1 1 t2)
s2 (xyp-SubUpd s2 1 t1)
)
)
(princ)
)

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

[提问] 这是论坛里单行文字交换的源码，请哪位可以改进一下

点评