求个文字的复制并平行直线的程序

baiyier1112

求个lisp程序：如图，将文字“皮带机中心线”连续复制到箭头所指位置，并让文字与直线平行。
注意：复制后原文字要保留

夏生生

改改还可以这样，完成一个文字的拷贝，右键，再选择另一个文字操作

2. 
   
3. ;;;拷贝文字随线角度 by x_s_s_1@163.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.   (while
    
23.   (setq ent (car (entsel "\n选择文字：")))
    
24.   (if (= "TEXT" (cdr (assoc 0 (entget ent))))
    
25.     (progn
    
26.       (while (setq enl (car (entsel "\n选择对齐线：")))
    
27. (if (= "LINE" (cdr (assoc 0 (entget enl))))
    
28.    (progn
    
29.      (setq pt1  (cdr (assoc 10 (entget enl)))
    
30.     pt2  (cdr (assoc 11 (entget enl)))
    
31.     mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt2 pt1)
    
32.     ang  (angle pt1 pt2)
    
33.      )
    
34.      (if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5)))
    
35.        (setq ang (- ang pi))
    
36.      )
    
37.      (emk_t (cdr (assoc 8 (entget ent)))
    
38.      '(0 0 0)
    
39.      (polar mid_pt (+ ang (* 0.5 pi)) 100)
    
40.      (cdr (assoc 1 (entget ent)))
    
41.      ang
    
42.      1
    
43.      0
    
44.      (cdr (assoc 40 (entget ent)))
    
45.      (cdr (assoc 41 (entget ent)))
    
46.      (cdr (assoc 7 (entget ent)))
    
47.      )
    
48.    )
    
49. )
    
50.       )
    
51.     )
    
52.   ))
    
53.   (princ)
    
54. )

<br /> ;;;拷贝文字随线角度 by x_s_s_1@163.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 />   (while<br />   (setq ent (car (entsel "\n选择文字：")))<br />   (if (= "TEXT" (cdr (assoc 0 (entget ent))))<br />     (progn<br />       (while (setq enl (car (entsel "\n选择对齐线：")))<br /> (if (= "LINE" (cdr (assoc 0 (entget enl))))<br />    (progn<br />      (setq pt1  (cdr (assoc 10 (entget enl)))<br />     pt2  (cdr (assoc 11 (entget enl)))<br />     mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt2 pt1)<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 /> )

lz123456

最好是框选，一下拷到线的中心，并支持自定义与线的距离

x_s_s_1

试试合用否

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

;;;拷贝文字随线角度 by x_s_s_1@163.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 (car (entsel "\n选择对齐线：")))<br /> (if (= "LINE" (cdr (assoc 0 (entget enl))))<br />    (progn<br />      (setq pt1  (cdr (assoc 10 (entget enl)))<br />     pt2  (cdr (assoc 11 (entget enl)))<br />     mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt2 pt1)<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 /> )<br />

zh.

tssd好像可以吧

baiyier1112

用探索者实现，需要2步操作：
第一步，复制文字到一个位置
第二步：用探索者的文字平行命令。

我想要一个命令完成：即将以上的两步用一个命令完成

wowan1314

搜索吧！记得G版帮人搞过一个！

yjr111

http://bbs.mjtd.com/thread-89922-1-1.html

baiyier1112

yjr111 发表于 2012-12-15 23:23
http://bbs.mjtd.com/thread-89922-1-1.html

谢谢。这个程序很好，我希望达到的目的是复制并将复制出的文字与线平行。原有的字要留下。

baiyier1112

x_s_s_1 发表于 2012-12-16 10:51
试试合用否

非常合适，万分感谢。
有个小请求，不知大侠能否将程序改进一下，将复制后的文字放到指定位置，而不单纯是线段的中点处。

x_s_s_1

baiyier1112 发表于 2012-12-16 11:19
非常合适，万分感谢。
有个小请求，不知大侠能否将程序改进一下，将复制后的文字放到指定位置，而不单纯 ...

我自己用倾向于放置于中心点，按照您的要求修改了一下，皮带一般都是用line线画的，所以没有对其它线条图元进行处理

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

<br /> ;;;拷贝文字随线角度 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 /> )