悬赏大侠帮忙写个小程序，按文字查找边界并提取到新图层

abao2005

现在需要这样的功能：在上面图中有砖、混2、泥等文字标注，希望批量选中这些文字，然后可以自动找到文字外面的边界，也就是那些房屋，生成边界后再希望分别提取到不同的图层，比如砖和砖的边界提取到图层“砖”（图层没有的要自动生成），混2和混2的边界自动提取到图层“混2”，图层“砖”、“混2”要关闭显示，同时把原来的图层上的砖、混2、泥等文字去掉。这样就能够方便的进行统计了。

不过在实际操作中，有些房屋存在细小的缺口，所以会导致不能提取边界，如果能解决这个问题就更好了，比如得到一个近似的边界也可以，只要能够自动闭合起来就可以了。

希望各位大侠帮忙一下！谢谢啦！

这是一个实例地形图。

print1985

2. ;提取文字边界  命令bj
   
3. (defun c:bj (/ en1 end1 en2 en3 end2 i ss txt txtpt)
   
4.   (setvar "cmdecho" 0)
   
5.   (command "_.undo" "_begin")
   
6.   (princ "选择含有<砖、混、泥>的文字")
   
7.   (if (setq ss (ssget '((1 . "砖*,混*,泥*")))) ;提取文字，文字内容请自行修改
   
8.     (progn
   
9.       (setq i 0)
   
10.       (repeat (sslength ss)
    
11.         (setq en1 (ssname ss i)
    
12.               end1 (entget en1)
    
13.               txt (cdr (assoc 1 end1))
    
14.               txtpt (cdr (assoc 10 end1))
    
15.               en3 (entlast)
    
16.         )
    
17.         (command "bpoly" txtpt "")
    
18.         (setq en2 (entlast)
    
19.                 end2 (entget en2)
    
20.          )
    
21.         (if (equal en2 en3)
    
22.           (princ "\n有未闭合区域，请检查!")
    
23.           (progn
    
24.             (entmod (setq end1 (subst(cons 8 txt)(assoc 8 end1)end1))) ;改文字图层
    
25.             (entmod (setq end2 (subst(cons 8 txt)(assoc 8 end2)end2))) ;改边界图层
    
26.             (command "layer" "off" txt "") ;关闭图层，不需要就删掉
    
27.           )
    
28.         )
    
29.         (setq i (1+ i))
    
30.       )
    
31.     )
    
32.   )
    
33.   (command "_.undo" "_end")
    
34.   (setvar "cmdecho" 1)
    
35.   (princ)
    
36. )

;提取文字边界  命令bj<br /> (defun c:bj (/ en1 end1 en2 en3 end2 i ss txt txtpt)<br />   (setvar "cmdecho" 0)<br />   (command "_.undo" "_begin")<br />   (princ "选择含有<砖、混、泥>的文字")<br />   (if (setq ss (ssget '((1 . "砖*,混*,泥*")))) ;提取文字，文字内容请自行修改<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq en1 (ssname ss i)<br />               end1 (entget en1)<br />               txt (cdr (assoc 1 end1))<br />               txtpt (cdr (assoc 10 end1))<br />               en3 (entlast)<br />         )<br />         (command "bpoly" txtpt "")<br />         (setq en2 (entlast)<br />                 end2 (entget en2)<br />          )<br />         (if (equal en2 en3)<br />           (princ "\n有未闭合区域，请检查!")<br />           (progn<br />             (entmod (setq end1 (subst(cons 8 txt)(assoc 8 end1)end1))) ;改文字图层<br />             (entmod (setq end2 (subst(cons 8 txt)(assoc 8 end2)end2))) ;改边界图层<br />             (command "layer" "off" txt "") ;关闭图层，不需要就删掉<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (command "_.undo" "_end")<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

再试试 不知是不是你要的效果

abao2005

补充一下，在有些线框里面是两个文字标注的，所以为了避免重复，是不是要再判断一下？

crazylsp

以文字的中心点向周围的线作最近点，然后比较出每个最近点离中心点距离最近的几条线，即为要找的边边界线。

abao2005

crazylsp 发表于 2013-1-22 11:34
以文字的中心点向周围的线作最近点，然后比较出每个最近点离中心点距离最近的几条线，即为要找的边边界线。

大侠帮忙写一个吧~

abao2005

谁来帮忙一下。

destnity

倒不是很难。关键是老大的明经币够不？
c#的可以不。

print1985

2. ;提取文字边界  命令bj
   
3. (defun c:bj (/ en1 end1 end2 i ss txt txtpt)
   
4.   (setvar "cmdecho" 0)
   
5.   (command "_.undo" "_begin")
   
6.   (princ "选择含有<砖、混、泥>的文字")
   
7.   (if (setq ss (ssget '((1 . "砖*,混*,泥*") (8 . "dx")))) ;dx为文字所在图层
   
8.     (progn
   
9.       (setq i 0)
   
10.       (repeat (sslength ss)
    
11.         (setq en1 (ssname ss i)
    
12.               end1 (entget en1)
    
13.               txt (cdr (assoc 1 end1))
    
14.               txtpt (cdr (assoc 10 end1))
    
15.         )
    
16.         (command "bpoly" txtpt "")
    
17.         (setq end2 (entget (entlast)))
    
18.         (entmod (setq end1 (subst(cons 8 txt)(assoc 8 end1)end1))) ;改文字图层
    
19.         (entmod (setq end2 (subst(cons 8 txt)(assoc 8 end2)end2))) ;改边界图层
    
20.         (setq i (1+ i))
    
21.       )
    
22.     )
    
23.   )
    
24.   (command "_.undo" "_end")
    
25.   (setvar "cmdecho" 1)
    
26.   (princ)
    
27. )

;提取文字边界  命令bj<br /> (defun c:bj (/ en1 end1 end2 i ss txt txtpt)<br />   (setvar "cmdecho" 0)<br />   (command "_.undo" "_begin")<br />   (princ "选择含有<砖、混、泥>的文字")<br />   (if (setq ss (ssget '((1 . "砖*,混*,泥*") (8 . "dx")))) ;dx为文字所在图层<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength ss)<br />         (setq en1 (ssname ss i)<br />               end1 (entget en1)<br />               txt (cdr (assoc 1 end1))<br />               txtpt (cdr (assoc 10 end1))<br />         )<br />         (command "bpoly" txtpt "")<br />         (setq end2 (entget (entlast)))<br />         (entmod (setq end1 (subst(cons 8 txt)(assoc 8 end1)end1))) ;改文字图层<br />         (entmod (setq end2 (subst(cons 8 txt)(assoc 8 end2)end2))) ;改边界图层<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (command "_.undo" "_end")<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

试试吧，只有基本功能，没对你说的特殊情况做处理
注意有2个相同文字在同一个边界内的，会生成2个重叠的边界
删掉重叠的相同图形请在本论坛另外找lisp

abao2005

print1985 发表于 2013-1-22 21:59
试试吧，只有基本功能，没对你说的特殊情况做处理
注意有2个相同文字在同一个边界内的，会生成2个重叠的边 ...

谢谢大侠出手，基本上可以达到我的要求了，不过能不能修改下以下三点：

1、不要对选取的文字和图层做判断，只判断选取的是文字就可以了

2、有些文字外面的框不能用bo命令生成边界，但是却把这个文字也提取到对应的图层了。请加一个判断：如果不能用bo命令生成边界，就不要把这个文字提取到对应的图层。
3、生成的边界图层默认为隐藏。

abao2005

destnity 发表于 2013-1-22 21:39
倒不是很难。关键是老大的明经币够不？
c#的可以不。

呃，发布悬赏令的时候已经支付了对应的明经币，50个明经币已经在这个帖子里面咯，所以不要担心钱的问题啦。

最好还是autolisp吧。