求助，请大神帮忙改一下文字齐线的小程序

NEWMEN

在一个求助帖http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99624&highlight=%CE%C4%D7%D6%2B%CF%DF里看到x_s_s_1这位大神写的一个文字齐线的程序，后来夏生生改过，觉得很好用，但只支持直线，不支持PL线，所以请哪位大神帮忙改进一下，使之能支持PL线，谢谢。另外请教怎么改成左对齐？



;;;拷贝文字随线角度 by x_s_s_1@163.com
(defun c:ctb (/ ent enl pt1 pt2 mid_pt ang)
  (defun emk_t (layer pt1 pt2 text ang n72 n73 h w sty /)
    (entmake (list '(0 . "text")
     '(100 . "AcDbEntity")
     (cons 8 layer)
     '(100 . "AcDbText")
     (cons 10 pt1)
     (cons 1 text)
     (cons 40 h)
     (cons 41 w)
     (cons 7 sty)
     (cons 72 n72)
     (cons 11 pt2)
     (cons 50 ang)
     (cons 73 n73)
      )
    )
  )
  (while
  (setq ent (car (entsel "\n选择文字：")))
  (if (= "TEXT" (cdr (assoc 0 (entget ent))))
    (progn
      (while (setq enl (car (entsel "\n选择对齐线：")))
(if (= "LINE" (cdr (assoc 0 (entget enl))))
   (progn
     (setq pt1  (cdr (assoc 10 (entget enl)))
    pt2  (cdr (assoc 11 (entget enl)))
    mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt2 pt1)
    ang  (angle pt1 pt2)
     )
     (if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5)))
       (setq ang (- ang pi))
     )
     (emk_t (cdr (assoc 8 (entget ent)))
     '(0 0 0)
     (polar mid_pt (+ ang (* 0.5 pi)) 100)
     (cdr (assoc 1 (entget ent)))
     ang
     1
     0
     (cdr (assoc 40 (entget ent)))
     (cdr (assoc 41 (entget ent)))
     (cdr (assoc 7 (entget ent)))
     )
   )
)
      )
    )
  ))
  (princ)
)

bai2000

大神们，都忙

xyp1964

1. (defun c:tt ()
   
2.   ;; tt(拷贝文字随线角度)
   
3.   (if (and (setq s1 (car (entsel "\n选择文字: ")))
   
4.            (xyp-Etype s1 "TEXT")
   
5.       )
   
6.     (progn
   
7.       (redraw s1 3)
   
8.       (while (and (setq e (entsel "\n选择对齐线: "))
   
9.                   (setq s2 (car e))
   
10.                   (xyp-curve-check s2)
    
11.                   (setq p0 (vlax-curve-getclosestpointto s2 (cadr e)))
    
12.                   (setq rad (xyp-Rad2Real (xyp-Get-AngleAtPoint s2 p0) 1))
    
13.              )
    
14.         ;;(xyp-Cross p0 300 0)
    
15.         (xyp-CopyMove s1 (xyp-9pt s1 5) p0)
    
16.         (xyp-SubUpd (entlast) 50 rad)
    
17.       )
    
18.       (redraw s1 4)
    
19.     )
    
20.   )
    
21.   (princ)
    
22. )

(defun c:tt ()<br />   ;; tt(拷贝文字随线角度)<br />   (if (and (setq s1 (car (entsel "\n选择文字: ")))<br />            (xyp-Etype s1 "TEXT")<br />       )<br />     (progn<br />       (redraw s1 3)<br />       (while (and (setq e (entsel "\n选择对齐线: "))<br />                   (setq s2 (car e))<br />                   (xyp-curve-check s2)<br />                   (setq p0 (vlax-curve-getclosestpointto s2 (cadr e)))<br />                   (setq rad (xyp-Rad2Real (xyp-Get-AngleAtPoint s2 p0) 1))<br />              )<br />         ;;(xyp-Cross p0 300 0)<br />         (xyp-CopyMove s1 (xyp-9pt s1 5) p0)<br />         (xyp-SubUpd (entlast) 50 rad)<br />       )<br />       (redraw s1 4)<br />     )<br />   )<br />   (princ)<br /> )