【求助】拷贝文字随线角度

yangchao2005090

2. ;;;拷贝文字随线角度 by x_s_s_1@163.com
   
3. (vl-load-com)
   
4. (defun c:ctb (/ ent enl pt1 pt2 mid_pt ang)
   
5.   (defun emk_t (layer pt1 pt2 text ang n72 n73 h w sty /)
   
6.     (entmake (list '(0 . "text")
   
7.      '(100 . "AcDbEntity")
   
8.      (cons 8 layer)
   
9.      '(100 . "AcDbText")
   
10.      (cons 10 pt1)
    
11.      (cons 1 text)
    
12.      (cons 40 h)
    
13.      (cons 41 w)
    
14.      (cons 7 sty)
    
15.      (cons 72 n72)
    
16.      (cons 11 pt2)
    
17.      (cons 50 ang)
    
18.      (cons 73 n73)
    
19.       )
    
20.     )
    
21.   )
    
22.   (setq ent (car (entsel "\n选择文字：")))
    
23.   (if (= "TEXT" (cdr (assoc 0 (entget ent))))
    
24.     (progn
    
25.       (while (setq enl (entsel "\n选择对齐线："))
    
26. (if (= "LINE" (cdr (assoc 0 (entget (car enl)))))
    
27.    (progn
    
28.      (setq pt1  (cdr (assoc 10 (entget (car enl))))
    
29.     pt2  (cdr (assoc 11 (entget (car enl))))
    
30.     mid_pt (vlax-curve-getClosestPointTo
    
31.       (vlax-ename->vla-object (car enl))
    
32.       (cadr enl)
    
33.     )
    
34.     ang  (angle pt1 pt2)
    
35.      )
    
36.      (if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5)))
    
37.        (setq ang (- ang pi))
    
38.      )
    
39.      (emk_t (cdr (assoc 8 (entget ent)))
    
40.      '(0 0 0)
    
41.      (polar mid_pt (+ ang (* 0.5 pi)) 100)
    
42.      (cdr (assoc 1 (entget ent)))
    
43.      ang
    
44.      1
    
45.      0
    
46.      (cdr (assoc 40 (entget ent)))
    
47.      (cdr (assoc 41 (entget ent)))
    
48.      (cdr (assoc 7 (entget ent)))
    
49.      )
    
50.    )
    
51. )
    
52.       )
    
53.     )
    
54.   )
    
55.   (princ)
    
56. )

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

上面是网上看到的源代码，遇到的问题如下：
1.只能适用于直线，pl线等无法使用，如果调整可以适合其他线性
2.文字平行线性后，距离线太远，如何调整距离

bai2000

不错，能改为通用函数更好

w245272914

不好用~~~~~    文字乱跑~

w245272914

不过感谢分享源码，大神

NEWMEN

哥们，这个求助我已经发了两次了，还没有大神帮忙呢

NEWMEN

哥们，试试这个，应该可以帮到你，我就用的这个。

NEWMEN

要不再来一个吧，如何，里面数据可自己改一下

yjtdkj

去看我的最新帖子
http://bbs.mjtd.com/thread-183635-1-1.html