[LISP程序]：使文字的倾角与直线的相同

yshf

;使文字的倾角与直线的相同
;本程序是根据lecohen的程序改编而成
;使各种对齐方式的单行文字的倾角与直线（LINE、XLINE、RAY）
;的倾角相同。
(defun c:wr(/ txt  txt1 na lin ps pe px1 px2 ang)
  (while (progn
           (setq txt (car (entsel "\n选择文字:")))
           (or (= txt nil) (/= "TEXT" (cdr (assoc 0 (setq txt1 (entget txt))))))
         )
  )
  (while (progn
           (setq lin (car (entsel "\n选择基准直线：")))
           (or (= lin nil)(not (member (setq na (cdr (assoc 0 (setq lin (entget lin))))) '("LINE" "XLINE" "RAY"))))
         )
  )
  (setq ps  (cdr (assoc 10 lin))
        pe  (cdr (assoc 11 lin))
        px1 (cdr (assoc 10 txt1))
        px2 (cdr (assoc 11 txt1))
        dd  (distance px1 px2)
  )
  (if (member na '("XLINE" "RAY")) (setq pe (mapcar '+ ps pe)))
  (setq ang (angle ps pe))
  (if (and (> ang (* pi 0.5)) (<= ang (* pi 1.5))) (setq ang (- ang pi)))
  (setq txt1 (subst (cons 11 (polar px1 ang dd)) (assoc 11 txt1) txt1))
  (if (not (member (cdr (assoc 72 txt1)) '(3 5)))
      (setq txt1 (subst (cons 50 ang) (assoc 50 txt1) txt1))
  )
  (entmod txt1)(redraw txt 3)
  (d-text txt)
  (princ)
)


;;;动态写文字，txt－－文字元素表
(defun d-text (ent / dxb px1 px2 dd tmp a)
  (setq dxb (entget ent)
        px1 (cdr (assoc 10 dxb))
        px2 (cdr (assoc 11 dxb))
        dd  (distance px1 px2)
        tmp t
  )
  (if (member (cdr (assoc 72 dxb)) '(3 5)) (setq ang (angle px1 px2)))
  (princ "\n选择点：")
  (while tmp
    (setq a (grread t 4 0))
    (cond  ((member (car a) '(3 12 25))
             (if (member (cdr (assoc 72 dxb)) '(3 5))
                 (setq dxb (subst (cons 11 (polar (cadr a) ang dd)) (assoc 11 dxb) dxb))
             )
             (setq dxb (subst (cons 10 (cadr a)) (assoc 10 dxb) dxb)
                   tmp nil
             )
             (entmod dxb)
           )
           ((= (car a) 5)
             (if (member (cdr (assoc 72 dxb)) '(3 5))
                 (setq dxb (subst (cons 11 (polar (cadr a) ang dd)) (assoc 11 dxb) dxb))
             )
             (setq dxb (subst (cons 10 (cadr a)) (assoc 10 dxb) dxb))
             (entmod dxb)(redraw ent 3)
           )
      )
   )
   (princ)
)

xyp1964

功能：文本（TEXT、MTEXT）与线或图块的角度相匹配
支持：LINE、POLYLINE、LWPOLYLINE、XLINE、INSERT

2. [FONT=courier new](load "xyp_lib")
   
3. ;|加载通用函数(可在签名栏直接下载)
   
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
5. 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
   
6. 1.在acad.lsp中增加(load"xyp_lib")
   
7. 2.在每个程序内增加(load"xyp_lib")
   
8. 3.在command下，输入(load"xyp_lib")
   
9. 4.在菜单.mnl中增加(load"xyp_lib")
   
10. 5.将xyp_lib.vlx文件直接拽到cad屏幕
    
11. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
13. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;
    
14. 
    
15. ;;;文本与线或图块的角度相匹配
    
16. (defun c:test ()
    
17.   (CMDLA0)
    
18.   (setq        s1 (entsel "\n选线或图块 : ")
    
19.         ob (dxf 0 (entget (car s1)))
    
20.   )
    
21.   (cond        ((= ob "INSERT") (setq ang (dxf 50 (entget (car s1)))))
    
22.         ((or (= ob "LINE")
    
23.              (= ob "POLYLINE")
    
24.              (= ob "LWPOLYLINE")
    
25.              (= ob "XLINE")
    
26.          )
    
27.          (curve-pts-pte s1)
    
28.          (setq ang (angle pts pte))
    
29.         )
    
30.         (t (princ))
    
31.   )
    
32.   (if ang
    
33.     (progn
    
34.       (while (> ang (/ pi 2.0))
    
35.         (setq ang (- ang pi))
    
36.       )
    
37.       (princ "\n选择文本 : ")
    
38.       (setq ss (ssget '((0 . "*TEXT")))
    
39.             i  -1
    
40.       )
    
41.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
42.         (sub_upd s1 50 ang)
    
43.       )
    
44.     )
    
45.   )
    
46.   (CMDLA1)
    
47. )[/FONT]

[FONT=courier new](load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式即可加载和运行通用函数内的所有子程序：<br /> 1.在acad.lsp中增加(load"xyp_lib")<br /> 2.在每个程序内增加(load"xyp_lib")<br /> 3.在command下，输入(load"xyp_lib")<br /> 4.在菜单.mnl中增加(load"xyp_lib")<br /> 5.将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;<br /> <br /> ;;;文本与线或图块的角度相匹配<br /> (defun c:test ()<br />   (CMDLA0)<br />   (setq        s1 (entsel "\n选线或图块 : ")<br />         ob (dxf 0 (entget (car s1)))<br />   )<br />   (cond        ((= ob "INSERT") (setq ang (dxf 50 (entget (car s1)))))<br />         ((or (= ob "LINE")<br />              (= ob "POLYLINE")<br />              (= ob "LWPOLYLINE")<br />              (= ob "XLINE")<br />          )<br />          (curve-pts-pte s1)<br />          (setq ang (angle pts pte))<br />         )<br />         (t (princ))<br />   )<br />   (if ang<br />     (progn<br />       (while (> ang (/ pi 2.0))<br />         (setq ang (- ang pi))<br />       )<br />       (princ "\n选择文本 : ")<br />       (setq ss (ssget '((0 . "*TEXT")))<br />             i  -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (sub_upd s1 50 ang)<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

PFD8667

我一直在寻找能一次到位的对齐程序,今天找到了很好用,谢谢楼主了,

xyp1964

试试这个：http://p4.xdcad.net/forum/showthread.php?s=&threadid=463127

lff763

为什么我的文本要炸开后才能选取到

lff763

请哪位测试修改一下

455383153

怎么支持多段线PLINE呢

455383153

怎么支持多段线PLINE呢

xdcad9819

感谢楼主分享 好资料 收藏 谢谢