社区 › AutoCAD与GIS测绘 › 如何根据闭合多段线内文字改多段线颜色

树櫴希德 发表于 2014-6-5 21:35:17

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

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

gzxl 发表于 2014-6-5 22:05:39

本帖最后由 gzxl 于 2014-6-5 22:08 编辑

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

zzyong00 发表于 2014-6-5 22:05:45

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

x_s_s_1 发表于 2014-6-6 11:29:20

写得很罗嗦，请包涵(vl-load-com)
(defun c:test1 (/ ss lst lst1 x y a b)
(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) "*挖方*")
             (vla-put-color y 1)
             )
           )
          (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)
)
)

树櫴希德 发表于 2014-6-6 14:13:18

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

树櫴希德 发表于 2014-6-6 18:15:42

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

树櫴希德 发表于 2014-6-6 18:17:46

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

树櫴希德 发表于 2014-6-6 18:25:41

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

flytoday 发表于 2014-6-6 22:22:20

本帖最后由 flytoday 于 2014-6-6 23:29 编辑

(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)
)
)
中午群内朋友改的这个采用输入比较通用会好点~~~

树櫴希德 发表于 2014-6-7 08:38:05

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

查看完整版本: 如何根据闭合多段线内文字改多段线颜色