zhangcan0515 发表于 2018-2-5 21:12:44

求助:数量一致的多个不同单行文字互换位置?

求助:实现数量一致的多个不同的单行文字互换其他行对应数量的单行文字

hpy 发表于 2018-2-5 21:12:45

试试下面这个程序是不是你想要的。
这个程序来源于明经或晓东,具体的忘记了。在原程序的基础上做了点改动。向原作者表示感谢!
(defun c:chgtp (/ ssg1 ssg2 n n1 ssn ssna ssn1 ssna1 pnt_y pnt_y1 snam ssnam
                  snam1 ssnam1 pnt_xy pnt_xy1 pt_xy pt_xy1 m m1 pn_y pn_y1
                  pn_xy pn_xy1 pnd_xy pnd_xy1 regnumber regnum)
    (setq n 0 n1 0 m 0 m1 0)
    (prompt "选取要交换位置的第一行文本:")
    (setq ssg1 (ssget))
    (prompt "选取要交换位置的第二行文本:")
    (setq ssg2 (ssget))
-------------------------------------------------------------------------------
;;如果每行文本中选择了非文本图元,则循环判断选择集中图元是否为单行文本,
;;如是单行文本,则终止循环,并获得该文本的y坐标。
    (repeat (sslength ssg1)
            (setq ssn (ssname ssg1 n))
            (setq ssna (entget ssn))
            (if (= "TEXT" (cdr (assoc 0 ssna))) (progn
                (setq pnt_y (cadr (cdr (assoc 10 ssna))))
                (setq pn_y (cadr (cdr (assoc 11 ssna))))
            ))
            (setq n (1+ n))
    )
    (repeat (sslength ssg2)
            (setq ssn1 (ssname ssg2 n1))
            (setq ssna1 (entget ssn1))
            (if (= "TEXT" (cdr (assoc 0 ssna1))) (progn
                (setq pnt_y1 (cadr (cdr (assoc 10 ssna1))))
                (setq pn_y1 (cadr (cdr (assoc 11 ssna1))))
             ))
            (setq n1 (1+ n1))
    )
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
;;循环取出每个选择集中各图元坐标的x坐标。如图元是文本,则用该文本的x坐标
;;与另一个选择集中的第一个文本的y坐标组合成新坐标,并替换原坐标
    (repeat (sslength ssg1)
            (setq snam (ssname ssg1 m))
            (setq ssnam (entget snam))
            (setq pnt_xy (cdr (assoc 10 ssnam)))
            (setq pn_xy (cdr (assoc 11 ssnam)))
            (if (= "TEXT" (cdr (assoc 0 ssnam)))
                (progn
                  (setq pt_xy (list 10 (car pnt_xy) pnt_y1))
                  (setq pnd_xy (list 11 (car pn_xy) pn_y1))
                  (setq ssnam (subst pt_xy (assoc 10 ssnam) ssnam))
                  (setq ssnam (subst pnd_xy (assoc 11 ssnam) ssnam))
                  (entmod ssnam)
               );;end progn
            ) ;;end if
         (setq m (1+ m))
    )
    (repeat (sslength ssg2)
            (setq snam1 (ssname ssg2 m1))
            (setq ssnam1 (entget snam1))
            (setq pnt_xy1 (cdr (assoc 10 ssnam1)))
            (setq pn_xy1 (cdr (assoc 11 ssnam1)))
            (if (= "TEXT" (cdr (assoc 0 ssnam1)))
                (progn
                  (setq text_ssna1 (assoc 1 ssnam1))
                  (setq pt_xy1 (list 10 (car pnt_xy1) pnt_y))
                  (setq pnd_xy1 (list 11 (car pn_xy1) pn_y))
                  (setq ssnam1 (subst pt_xy1 (assoc 10 ssnam1) ssnam1))
                  (setq ssnam1 (subst pnd_xy1 (assoc 11 ssnam1) ssnam1))
                  (entmod ssnam1)
               ) ;;end progn
            ) ;;end if
         (setq m1 (1+ m1))
    )
    (princ)
)
---------------------------------------------------------------------------------------

mikewolf2k 发表于 2018-2-6 09:53:31

选中移动有啥问题?

xyp1964 发表于 2018-2-6 13:50:56


zhangcan0515 发表于 2018-2-6 23:14:52

xyp1964 发表于 2018-2-6 13:50


实战上这个并没有我想的那样好用,哎 谢谢院长演示

LIULISHENG 发表于 2018-2-7 08:29:17

学习了支持

fl202 发表于 2018-2-7 08:49:21

LIULISHENG 发表于 2018-2-7 08:29
学习了支持

那都有你,到处灌水。。。

污人眼。

LIULISHENG 发表于 2018-2-7 10:03:19

fl202 发表于 2018-2-7 08:49
那都有你,到处灌水。。。

污人眼。

不回贴不行回贴也不行,我学习下也不行?

fl202 发表于 2018-2-7 10:42:08

LIULISHENG 发表于 2018-2-7 10:03
不回贴不行回贴也不行,我学习下也不行?

不要纯灌水,要灌水去晓东。
学习后就反馈明经,发源码/发思路/发算法/解答问题都是帮人啊。
纯灌水除了浪费大家时间,对论坛对别人都没有好处。
找个资料,看个回复,满眼都是水,谁喜欢啊?

LIULISHENG 发表于 2018-2-7 13:28:47

fl202 发表于 2018-2-7 10:42
不要纯灌水,要灌水去晓东。
学习后就反馈明经,发源码/发思路/发算法/解答问题都是帮人啊。
纯灌水除 ...

受教了:lol:lol:lol:handshake
页: [1] 2
查看完整版本: 求助:数量一致的多个不同单行文字互换位置?