如何根据闭合多段线内文字改多段线颜色

树櫴希德

如何根据闭合多段线内文字改多段线颜色，假如闭合多段线内TEXT包含：填方，就把此闭合多段线改为红色。如图：

gzxl

这个容易呀，明经和晓东都有像此类的源码
比如这里http://www.xdcad.net/FORUM/forum.php?mod=viewthread&tid=668857&extra=

zzyong00

SelectByPolygon 选择多线段内的对象，逐个判断..........

x_s_s_1

写得很罗嗦，请包涵

2. (vl-load-com)
   
3. (defun c:test1 (/ ss lst lst1 x y a b)
   
4.   (setq ss (ssget '((0 . "lwpolyline"))))
   
5.   (defun ss->lst (ss / n lst)
   
6.     (repeat (setq N (sslength ss))
   
7.       (setq LST (cons (ssname SS (setq N (1- N))) LST))
   
8.     )
   
9.   )
   
10.   (setq        lst  (ss->lst ss)
    
11.         lst1 (mapcar '(lambda (x)
    
12.                         (mapcar        'cdr
    
13.                                 (vl-remove-if-not
    
14.                                   '(lambda (y) (= 10 (car y)))
    
15.                                   (entget x)
    
16.                                 )
    
17.                         )
    
18.                       )
    
19.                      lst
    
20.              )
    
21.   )
    
22.   (mapcar '(lambda (x y)
    
23.              (if (wcmatch (apply 'strcat x) "*挖方*")
    
24.                (vla-put-color y 1)
    
25.              )
    
26.            )
    
27.           (mapcar '(lambda (a)
    
28.                      (mapcar '(lambda (b) (cdr (assoc 1 (entget b))))
    
29.                              (ss->lst (ssget "cp" a '((0 . "text"))))
    
30.                      )
    
31.                    )
    
32.                   lst1
    
33.           )
    
34.           (mapcar 'vlax-ename->vla-object lst)
    
35.   )
    
36. )

(vl-load-com)<br /> (defun c:test1 (/ ss lst lst1 x y a b)<br />   (setq ss (ssget '((0 . "lwpolyline"))))<br />   (defun ss->lst (ss / n lst)<br />     (repeat (setq N (sslength ss))<br />       (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />     )<br />   )<br />   (setq        lst  (ss->lst ss)<br />         lst1 (mapcar '(lambda (x)<br />                         (mapcar        'cdr<br />                                 (vl-remove-if-not<br />                                   '(lambda (y) (= 10 (car y)))<br />                                   (entget x)<br />                                 )<br />                         )<br />                       )<br />                      lst<br />              )<br />   )<br />   (mapcar '(lambda (x y)<br />              (if (wcmatch (apply 'strcat x) "*挖方*")<br />                (vla-put-color y 1)<br />              )<br />            )<br />           (mapcar '(lambda (a)<br />                      (mapcar '(lambda (b) (cdr (assoc 1 (entget b))))<br />                              (ss->lst (ssget "cp" a '((0 . "text"))))<br />                      )<br />                    )<br />                   lst1<br />           )<br />           (mapcar 'vlax-ename->vla-object lst)<br />   )<br /> )

树櫴希德

自古英雄出明经，多才多艺又热心。赞X_ S _S _1

树櫴希德

不过美中不足之处就是批量选择时有未包含指定文字多段线就出现：

树櫴希德

错误: 参数类型错误: lselsetp nil或者选择对象:(nil nil nil nil nil nil nil nil nil nil nil nil nil)

树櫴希德

知道了，把文字改到最小就行了。谢谢

flytoday

(vl-load-com)
(defun c:plwzys (/ ss lst lst1 x y a b)
   (setq strxx (getstring "输入匹配字符:"))   ;输入
  (setq ss (ssget '((0 . "lwpolyline"))))
  (defun ss->lst (ss / n lst)
    (repeat (setq N (sslength ss))
      (setq LST (cons (ssname SS (setq N (1- N))) LST))
    )
  )
  (setq lst  (ss->lst ss)
lst1 (mapcar '(lambda (x)
   (mapcar 'cdr
    (vl-remove-if-not
      '(lambda (y) (= 10 (car y)))
      (entget x)
    )
   )
        )
       lst
      )
  )

  (mapcar '(lambda (x y)
      (if (wcmatch (apply 'strcat x) (strcat "*" strxx "*"))
        (vla-put-color y 5)；改颜色
      )
    )
   (mapcar '(lambda (a)
       (mapcar '(lambda (b) (cdr (assoc 1 (entget b))))
        (ss->lst (ssget "cp" a '((0 . "text"))))
       )
     )
    lst1
   )
   (mapcar 'vlax-ename->vla-object lst)
  )
)
中午群内朋友改的这个采用输入比较通用会好点~~~

树櫴希德

热心人好多啊，希望这贴被更多人看到。