试试下面这个程序是不是你想要的。
这个程序来源于明经或晓东,具体的忘记了。在原程序的基础上做了点改动。向原作者表示感谢!
- (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)
- )
- ---------------------------------------------------------------------------------------
|