大侠帮忙完善，谢谢。

fcut2004

各位大侠，下面的代码是本人在网上下载的文字与线对齐的lisp。但是选直线必须是针对非块内或参照内的直线才可以，请问如何能使选直线时，像剪切、延伸那样对于块内或者是参照内的直线都可以选择啊，谢谢。
;文字与直线对齐
(defun C:tt (/ x y laa lin lab pt1 pt2 v1 slin ang tex name index nang oang b)
  (setvar "cmdecho" 0)
  (while (= y nil)
    (progn
      (setq laa (entsel "\nselect the source obj. [or specify 2 point(2p)] "
))
      (if (/= laa nil)
(progn
   (setq lin (entget (car laa)))
   (setq x (cdr (assoc 0 lin)))
   (setq y (or (= x "LWPOLYLINE")
        (= x "LINE")
        (= x "TEXT")
        (= x "MTEXT")
))) ;progn
(progn
   (setq y 2)
   (setq pt1 (getpoint ":\nspecify first point"))
   (setq pt2 (getpoint pt1 ":\nspecify second point"))
   (coang)
) ;progn
      ) ;if
    ) ;progn
  ) ;while
(cond ((= (cdr (assoc 0 lin)) "LWPOLYLINE")
  (progn
    (setq pt1 (cdr (assoc 10 lin)))
    (setq v1 (cons 10 pt1))
    (setq slin (cdr (member v1 lin)))
    (setq pt2 (cdr (assoc 10 slin)))
    (coang)
)))
  (cond ((= (cdr (assoc 0 lin)) "LINE")
  (progn
    (setq pt1 (cdr (assoc 10 lin)))
    (setq pt2 (cdr (assoc 11 lin)))
    (coang)
)))
  (cond ((= (cdr (assoc 0 lin)) "TEXT")
  (progn
    (setq ang (cdr (assoc 50 lin)))
)))
  (cond ((= (cdr (assoc 0 lin)) "MTEXT")
  (progn
    (setq ang (cdr (assoc 50 lin)))
)))
  (prompt "\nselect the words to be turned: ")
  (while (= lab nil)
    (setq lab (ssget
  '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))
))) ;while
  (setq index 0)
  (setq n (sslength lab))
  (repeat n
    (setq name (ssname lab index))
    (setq tex (entget name))
    (setq index (+ index 1))
    (setq nang (cons 50 ang))
    (setq oang (assoc 50 tex))
    (setq b (subst nang oang tex))
    (entmod b)
  )
  (setvar "cmdecho" 1)
  (princ)
);;
(defun coang ()
  (setq ang (angle pt1 pt2))
  (if (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))
    (progn
      (setq ang (+ ang pi))
)))
;文字与直线对齐

tjuzkj

(setq laa (entsel "\nselect the source obj. [or specify 2 point(2p)] "改成
(setq laa (nentsel "\nselect the source obj. [or specify 2 point(2p)] "

duuudu

才知道原来还有nentsel这么个函数，学习了

duuudu

2. (defun C:tt (/ x y laa lin lab pt1 pt2 v1 slin ang tex name index nang oang b)
   
3.   (setvar "cmdecho" 0)
   
4.   (while (= y nil)
   
5.     (progn
   
6.       (setq laa (nentsel "\n选择直线或多义线. [直接回车点取两点]：";;--修改成中文，按指点改成nentsel
   
7. ))
   
8.       (if laa ;;--不必要
   
9. (progn
   
10.    (setq lin (entget (car laa)))
    
11.    (setq x (cdr (assoc 0 lin)))
    
12.    (setq y (or (= x "LWPOLYLINE")
    
13.         (= x "LINE")
    
14.         (= x "TEXT")
    
15.         (= x "MTEXT")
    
16. ))) ;progn
    
17. (progn
    
18.    (setq y t);;--直接t
    
19.    (setq pt1 (getpoint ":\n第一点："));;--修改成中文
    
20.    (setq pt2 (getpoint pt1 ":\n第二点："));;--修改成中文
    
21.    (coang)
    
22. ) ;progn
    
23.       ) ;if
    
24.     ) ;progn
    
25.   ) ;while
    
26. (cond ((= x "LWPOLYLINE");;--cond用法修正，(cdr (assoc 0 lin))直接可以用x代替以避免重复计算，下同
    
27.   (progn
    
28.     (setq pt1 (cdr (assoc 10 lin)))
    
29.     (setq v1 (cons 10 pt1))
    
30.     (setq slin (cdr (member v1 lin)))
    
31.     (setq pt2 (cdr (assoc 10 slin)))
    
32.     (coang)
    
33. ))
    
34.   ((= x "LINE")
    
35.   (progn
    
36.     (setq pt1 (cdr (assoc 10 lin)))
    
37.     (setq pt2 (cdr (assoc 11 lin)))
    
38.     (coang)
    
39. ))
    
40.   ((= x "TEXT")
    
41.   (progn
    
42.     (setq ang (cdr (assoc 50 lin)))
    
43. ))
    
44.   ((= x "MTEXT")
    
45.   (progn
    
46.     (setq ang (cdr (assoc 50 lin)))
    
47. )))
    
48.   (prompt "\n选择文字：");;--修改成中文
    
49.   (while (= lab nil)
    
50.     (setq lab (ssget
    
51.   '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))
    
52. ))) ;while
    
53.   (setq index 0)
    
54.   (setq n (sslength lab))
    
55.   (repeat n
    
56.     (setq name (ssname lab index))
    
57.     (setq tex (entget name))
    
58.     (setq index (+ index 1))
    
59.     (setq nang (cons 50 ang))
    
60.     (setq oang (assoc 50 tex))
    
61.     (setq b (subst nang oang tex))
    
62.     (entmod b)
    
63.   )
    
64.   (setvar "cmdecho" 1)
    
65.   (princ)
    
66. );;
    
67. (defun coang ()
    
68.   (setq ang (angle pt1 pt2))
    
69.   (if (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))
    
70.     (progn
    
71.       (setq ang (+ ang pi))
    
72. )))
    
73. ;文字与直线对齐

(defun C:tt (/ x y laa lin lab pt1 pt2 v1 slin ang tex name index nang oang b)<br />   (setvar "cmdecho" 0)<br />   (while (= y nil)<br />     (progn<br />       (setq laa (nentsel "\n选择直线或多义线. [直接回车点取两点]：";;--修改成中文，按指点改成nentsel<br /> ))<br />       (if laa ;;--不必要<br /> (progn<br />    (setq lin (entget (car laa)))<br />    (setq x (cdr (assoc 0 lin)))<br />    (setq y (or (= x "LWPOLYLINE")<br />         (= x "LINE")<br />         (= x "TEXT")<br />         (= x "MTEXT")<br /> ))) ;progn<br /> (progn<br />    (setq y t);;--直接t<br />    (setq pt1 (getpoint ":\n第一点："));;--修改成中文<br />    (setq pt2 (getpoint pt1 ":\n第二点："));;--修改成中文<br />    (coang)<br /> ) ;progn<br />       ) ;if<br />     ) ;progn<br />   ) ;while<br /> (cond ((= x "LWPOLYLINE");;--cond用法修正，(cdr (assoc 0 lin))直接可以用x代替以避免重复计算，下同<br />   (progn<br />     (setq pt1 (cdr (assoc 10 lin)))<br />     (setq v1 (cons 10 pt1))<br />     (setq slin (cdr (member v1 lin)))<br />     (setq pt2 (cdr (assoc 10 slin)))<br />     (coang)<br /> ))<br />   ((= x "LINE")<br />   (progn<br />     (setq pt1 (cdr (assoc 10 lin)))<br />     (setq pt2 (cdr (assoc 11 lin)))<br />     (coang)<br /> ))<br />   ((= x "TEXT")<br />   (progn<br />     (setq ang (cdr (assoc 50 lin)))<br /> ))<br />   ((= x "MTEXT")<br />   (progn<br />     (setq ang (cdr (assoc 50 lin)))<br /> )))<br />   (prompt "\n选择文字：");;--修改成中文<br />   (while (= lab nil)<br />     (setq lab (ssget<br />   '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))<br /> ))) ;while<br />   (setq index 0)<br />   (setq n (sslength lab))<br />   (repeat n<br />     (setq name (ssname lab index))<br />     (setq tex (entget name))<br />     (setq index (+ index 1))<br />     (setq nang (cons 50 ang))<br />     (setq oang (assoc 50 tex))<br />     (setq b (subst nang oang tex))<br />     (entmod b)<br />   )<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> );;<br /> (defun coang ()<br />   (setq ang (angle pt1 pt2))<br />   (if (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))<br />     (progn<br />       (setq ang (+ ang pi))<br /> )))<br /> ;文字与直线对齐

在楼主的基础上简单做了修改，没有进行较大改动。

梦醒才知原是梦

soga~~~~~~~~~~~~~~~~~

lshpool

duuudu 发表于 2012-7-24 23:20
在楼主的基础上简单做了修改，没有进行较大改动。

不够完善：1，不支持天正文字。2，对齐后，如果文字能和直线保持一定的距离就好了，例如1/2字高。3，楼上的修改，的确可以支持块中的直线，但对于自定义坐标系，文字无法对齐

fcut2004

lshpool 发表于 2012-8-2 22:14
不够完善：1，不支持天正文字。2，对齐后，如果文字能和直线保持一定的距离就好了，例如1/2字高。3，楼上 ...

使用这个命令时，定义为世界坐标系，命令结束后回到自定义坐标系不就可以了