[LISP程序]：文本位置交换程序

ycao

看了论坛文章中心的“为AutoCAD增加几个实用小工具”的文章，其中一个实用小工具是对两个文本进行位置互换，觉得很有用。不过觉得有点不方便，程序只能对两个文本进行位置互换。因此，试着写了一个对两行文本进行位置互换的程序。本程序既可单选，也可多选。
  由于本人只懂一点点编程，因此，大家如果觉得程序写得不好，请多多谅解。

用法：第一行文本选择完毕后，回车，再选择第二行文本。

  (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)
    (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)))
                (setq pnt_y (cadr (cdr (assoc 10 ssna))))
            )
            (setq n (1+ n))
    )
    (repeat (sslength ssg2)
            (setq ssn1 (ssname ssg2 n1))
            (setq ssna1 (entget ssn1))
            (if (= "TEXT" (cdr (assoc 0 ssna1)))
                (setq pnt_y1 (cadr (cdr (assoc 10 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)))
            (if (= "TEXT" (cdr (assoc 0 ssnam)))
                (progn
                  (setq pt_xy (list 10 (car pnt_xy) pnt_y1 ))
                  (setq ssnam (subst pt_xy (assoc 10 ssnam) ssnam))
                  (cond ((/= 0 (cdr (assoc 72 ssnam)))
                         (setq ssnam (subst (cons 72 0) (assoc 72 ssnam) ssnam)))
                        ((/= 0 (cdr (assoc 73 ssnam)))
                         (setq ssnam (subst (cons 73 0) (assoc 73 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)))
            (if (= "TEXT" (cdr (assoc 0 ssnam1)))
                (progn
                  (setq text_ssna1 (assoc 1 ssnam1))
                  (setq pt_xy1 (list 10 (car pnt_xy1) pnt_y ))
                  (setq ssnam1 (subst pt_xy1 (assoc 10 ssnam1) ssnam1))
                  (cond ((/= 0 (cdr (assoc 72 ssnam1)))
                         (setq ssnam1 (subst (cons 72 0) (assoc 72 ssnam1) ssnam1)))
                        ((/= 0 (cdr (assoc 73 ssnam1)))
                         (setq ssnam1 (subst (cons 73 0) (assoc 73 ssnam1) ssnam1)))
                  )
                 (entmod ssnam1)
                 ) ;;end progn
            ) ;;end if
           (setq m1 (1+ m1))
    )
)
---------------------------------------------------------------------------------------
(princ "\n程序已加载!程序命令名：chgtp ")

自由的鱼

写的不错，楼主继续~~

jx2008

有点意思，不过没多大用处阿，空的时候消磨时间玩玩也好啊