获取字符串坐标并画线

cz7873559

zxq0220

2. ;同串变绿并连线 晓东 zxq0220 2013.6.8
   
3. (defun c:tt ()
   
4. (if (and (setq pt1 (getpoint "\n框选第一角点: "))
   
5.           (setq pt2 (getcorner pt1 "\n框选另一角点: "))) (progn
   
6.   (setq ss (ssget "W" pt1 pt2 '((0 . "TEXT"))))
   
7.   (setq i -1 tlst (list))
   
8.   (repeat (sslength ss)
   
9.    (setq en (ssname ss (setq i (1+ i)))
   
10.          ent (entget en)
    
11.          txt (cdr(assoc 1 ent))
    
12.          pt (cdr(assoc 10 ent)))
    
13.    (if (assoc txt tlst)
    
14.     (setq tlst (subst (cons txt (1+ (cdr(assoc txt tlst)))) (assoc txt tlst) tlst))
    
15.     (setq tlst (cons (cons txt 1) tlst))
    
16.    )
    
17.   )
    
18.   (foreach x tlst
    
19.    (if (> (cdr x) 1) (progn
    
20.     (setq ss1 (ssget "W" pt1 pt2 (list '(0 . "TEXT") (cons 1 (car x)))))
    
21.     (setq i 0)
    
22.     (setq ent1 (entget(ssname ss1 0)))
    
23.     (setq pt (cdr(assoc 10 ent1)))
    
24.     (if (assoc 62 ent1)
    
25.      (entmod (subst '(62 . 3) (assoc 62 ent1) ent1))
    
26.      (entmod (append ent1 '((62 . 3))))
    
27.     )
    
28.     (repeat (1- (sslength ss1))
    
29.      (setq ent1 (entget(ssname ss1 (setq i (1+ i))))
    
30.           p1 (cdr(assoc 10 ent1)))
    
31.      (if (assoc 62 ent1)
    
32.       (entmod (subst '(62 . 3) (assoc 62 ent1) ent1))
    
33.       (entmod (append ent1 '((62 . 3))))
    
34.      )
    
35.      (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 p1) '(8 . "XT") '(62 . 3)))
    
36.      (setq pt p1)
    
37.     )
    
38.    ))
    
39.   )
    
40. ))
    
41. (princ)
    
42. )
    

;同串变绿并连线 晓东 zxq0220 2013.6.8<br /> (defun c:tt ()<br /> (if (and (setq pt1 (getpoint "\n框选第一角点: "))<br />           (setq pt2 (getcorner pt1 "\n框选另一角点: "))) (progn<br />   (setq ss (ssget "W" pt1 pt2 '((0 . "TEXT"))))<br />   (setq i -1 tlst (list))<br />   (repeat (sslength ss)<br />    (setq en (ssname ss (setq i (1+ i)))<br />          ent (entget en)<br />          txt (cdr(assoc 1 ent))<br />          pt (cdr(assoc 10 ent)))<br />    (if (assoc txt tlst)<br />     (setq tlst (subst (cons txt (1+ (cdr(assoc txt tlst)))) (assoc txt tlst) tlst))<br />     (setq tlst (cons (cons txt 1) tlst))<br />    )<br />   )<br />   (foreach x tlst<br />    (if (> (cdr x) 1) (progn<br />     (setq ss1 (ssget "W" pt1 pt2 (list '(0 . "TEXT") (cons 1 (car x)))))<br />     (setq i 0)<br />     (setq ent1 (entget(ssname ss1 0)))<br />     (setq pt (cdr(assoc 10 ent1)))<br />     (if (assoc 62 ent1)<br />      (entmod (subst '(62 . 3) (assoc 62 ent1) ent1))<br />      (entmod (append ent1 '((62 . 3))))<br />     )<br />     (repeat (1- (sslength ss1))<br />      (setq ent1 (entget(ssname ss1 (setq i (1+ i))))<br />           p1 (cdr(assoc 10 ent1)))<br />      (if (assoc 62 ent1)<br />       (entmod (subst '(62 . 3) (assoc 62 ent1) ent1))<br />       (entmod (append ent1 '((62 . 3))))<br />      )<br />      (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 p1) '(8 . "XT") '(62 . 3)))<br />      (setq pt p1)<br />     )<br />    ))<br />   )<br /> ))<br /> (princ)<br /> )<br />

Free-Lancer

奇了怪，这里怎么成了这样？
_1_$ str
"fy吴大英"
_1_$ (read str)
FY何力富

ll_j

Free-Lancer 发表于 2013-6-8 08:45
奇了怪，这里怎么成了这样？
_1_$ str
"fy吴大英"

read函数在对付中文字符串时会出错，具体原因和出错结果也未知，上次明经有一个帖子，后来测试一下，自以为找到出错原因了，谁知后来发现还是不对。

Lisphk

ll_j 发表于 2013-6-8 09:24
read函数在对付中文字符串时会出错，具体原因和出错结果也未知，上次明经有一个帖子，后来测试一下，自以 ...

长老，上次找到的原因是什么，能不能分享下？

cz7873559

zxq0220 发表于 2013-6-8 08:24

谢谢，这样就没有出错了。

cz7873559

Free-Lancer 发表于 2013-6-8 08:45
奇了怪，这里怎么成了这样？
_1_$ str
"fy吴大英"

原来是这样哦。

ll_j

Lisphk 发表于 2013-6-8 10:45
长老，上次找到的原因是什么，能不能分享下？

好不容易找到以前的帖子：http://bbs.mjtd.com/thread-99199-1-1.html
在11楼有我的回复，当时感觉是这样，不过后来有遇到过类似的情况，感觉这个回复的猜想也不正确。

cz7873559

cz7873559 发表于 2013-6-8 11:32
谢谢，这样就没有出错了。

如果一个图中有3个以上的字符是相同的，框选两个之后，没选到（或是在隐藏的图层）的第三个（）也会跟着连线。我想要如果第三个没选上就不连线。麻烦再帮我改下嘛

XDSoft

cz7873559 发表于 2013-6-8 13:42
如果一个图中有3个以上的字符是相同的，框选两个之后，没选到（或是在隐藏的图层）的第三个（）也会跟 ...

你和自己说话，人家上来时候收不到通知的。

ll_j

我也凑上一段：

1. 
   
2. (defun c:tt (/ ss i lst ls1 ls2)
   
3.   (princ "\n判断相同的文字并连线。")
   
4.   (princ "\n选择要判断的文字：")
   
5.   (setq ss (ssget '((0 . "text"))))
   
6.   (if ss
   
7.     (progn
   
8.       (setq i   -1
   
9.             lst nil
   
10.       )
    
11.       (repeat (sslength ss)
    
12.         (setq lst (cons (entget (ssname ss (setq i (1+ i)))) lst))
    
13.       )
    
14.       (setq lst (vl-sort
    
15.                   lst
    
16.                   '(lambda (x y)
    
17.                      (< (cdr (assoc 1 x)) (cdr (assoc 1 y)))
    
18.                    )
    
19.                 )
    
20.             ls1 (list (car lst))
    
21.             ls2 nil
    
22.       )
    
23.       (while (cdr lst)
    
24.         (if (= (cdr (assoc 1 (car lst)))
    
25.                (cdr (assoc 1 (setq e1 (cadr lst))))
    
26.             )
    
27.           (setq ls1 (cons e1 ls1)
    
28.                 lst (cdr lst)
    
29.           )
    
30.           (setq ls2 (cons ls1 ls2)
    
31.                 ls1 (list e1)
    
32.                 lst (cdr lst)
    
33.           )
    
34.         )
    
35.       )
    
36.       (setq ls2 (cons ls1 ls2))
    
37.       (mapcar
    
38.         '(lambda (n)
    
39.            (if (> (length n) 1)
    
40.              (progn
    
41.                (mapcar
    
42.                  '(lambda (x)
    
43.                     (if (assoc 62 x)
    
44.                       (entmod (subst '(62 . 3) (assoc 62 x) x))
    
45.                       (entmod (append x '((62 . 3))))
    
46.                     )
    
47.                   )
    
48.                  n
    
49.                )
    
50.                (mapcar
    
51.                  '(lambda (x1 x2)
    
52.                     (entmake
    
53.                       (list '(0 . "LINE")
    
54.                             (if (and (= (cdr (assoc 72 x1)) 0)
    
55.                                      (= (cdr (assoc 73 x1)) 0)
    
56.                                 )
    
57.                               (assoc 10 x1)
    
58.                               (cons 10 (cdr (assoc 11 x1)))
    
59.                             )
    
60.                             (if (and (= (cdr (assoc 72 x2)) 0)
    
61.                                      (= (cdr (assoc 73 x2)) 0)
    
62.                                 )
    
63.                               (cons 11 (cdr (assoc 10 x2)))
    
64.                               (assoc 11 x2)
    
65.                             )
    
66.                             '(62 . 3)
    
67.                       )
    
68.                     )
    
69.                   )
    
70.                  n
    
71.                  (cdr n)
    
72.                )
    
73.              )
    
74.            )
    
75.          )
    
76.         ls2
    
77.       )
    
78.     )
    
79.     (princ "\n未选择文字。")
    
80.   )
    
81.   (princ)
    
82. )
    

<br /> (defun c:tt (/ ss i lst ls1 ls2)<br />   (princ "\n判断相同的文字并连线。")<br />   (princ "\n选择要判断的文字：")<br />   (setq ss (ssget '((0 . "text"))))<br />   (if ss<br />     (progn<br />       (setq i   -1<br />             lst nil<br />       )<br />       (repeat (sslength ss)<br />         (setq lst (cons (entget (ssname ss (setq i (1+ i)))) lst))<br />       )<br />       (setq lst (vl-sort<br />                   lst<br />                   '(lambda (x y)<br />                      (< (cdr (assoc 1 x)) (cdr (assoc 1 y)))<br />                    )<br />                 )<br />             ls1 (list (car lst))<br />             ls2 nil<br />       )<br />       (while (cdr lst)<br />         (if (= (cdr (assoc 1 (car lst)))<br />                (cdr (assoc 1 (setq e1 (cadr lst))))<br />             )<br />           (setq ls1 (cons e1 ls1)<br />                 lst (cdr lst)<br />           )<br />           (setq ls2 (cons ls1 ls2)<br />                 ls1 (list e1)<br />                 lst (cdr lst)<br />           )<br />         )<br />       )<br />       (setq ls2 (cons ls1 ls2))<br />       (mapcar<br />         '(lambda (n)<br />            (if (> (length n) 1)<br />              (progn<br />                (mapcar<br />                  '(lambda (x)<br />                     (if (assoc 62 x)<br />                       (entmod (subst '(62 . 3) (assoc 62 x) x))<br />                       (entmod (append x '((62 . 3))))<br />                     )<br />                   )<br />                  n<br />                )<br />                (mapcar<br />                  '(lambda (x1 x2)<br />                     (entmake<br />                       (list '(0 . "LINE")<br />                             (if (and (= (cdr (assoc 72 x1)) 0)<br />                                      (= (cdr (assoc 73 x1)) 0)<br />                                 )<br />                               (assoc 10 x1)<br />                               (cons 10 (cdr (assoc 11 x1)))<br />                             )<br />                             (if (and (= (cdr (assoc 72 x2)) 0)<br />                                      (= (cdr (assoc 73 x2)) 0)<br />                                 )<br />                               (cons 11 (cdr (assoc 10 x2)))<br />                               (assoc 11 x2)<br />                             )<br />                             '(62 . 3)<br />                       )<br />                     )<br />                   )<br />                  n<br />                  (cdr n)<br />                )<br />              )<br />            )<br />          )<br />         ls2<br />       )<br />     )<br />     (princ "\n未选择文字。")<br />   )<br />   (princ)<br /> )<br />

cz7873559

代码运行后一个图中有3个以上的字符是相同的，框选两个之后，没选到（或是在隐藏的图层）的第三个也会跟着连线。我想，只比较框选内的文字，如果没选上就不连线。麻烦你再帮我改下嘛

cz7873559

ll_j 发表于 2013-6-8 15:51
我也凑上一段：

你们都是高手！你的也能实现，而且只比较框选的范围了。我想把在XT层画线并且线的颜色随层。该在哪里加呢？

cz7873559

谢谢 ll_j  
我已经改了。把
'(62 . 3)=>'(8 . "XT") '(62 . 256)。就可以实现在xt下画线并颜色随层了

zxq0220

cz7873559 发表于 2013-6-8 15:52
代码运行后一个图中有3个以上的字符是相同的，框选两个之后，没选到（或是在隐藏的图层）的第三个也会跟着 ...

32楼已改。