[原创]：选择线段图元进行多边形拓朴，请测试

xiao_longxin

感兴趣的可以先看一下录像[/COLOR]
[swf w=550 h=400]http://p4.xdcad.net/forum/file_upload/530469_1.swf[/swf]
可在本帖最后下载打包编译好的VLX测试，已经对程序进行了改进，支持PLINE和LINE，并修正了有些多边形带小尾巴的Bug，命令名：TEST[/COLOR]

输出了多边形之间的关系，以便于有不同用途的进一步编程

以有时间了继续完成：1。点选多边形中自动索取包含该点的最小多边形，类似BHATCH

                                   2。相交处不需有折点也能自动判断

用到很多通用函数，请在
http://www.xdcad.net/forum/showt ... 2723430#post2723430 [/COLOR]
下载

还用到了关于计算几何的函数，请在
http://www.xdcad.net/forum/showt ... 2723451#post2723451 [/COLOR]
下载

2. 
   
3. (defun c:test (/        data   n      i     k    j      pt_lst dbx_lst
   
4.          gx_lst dbx       dbx_po n_pt     n_dbx    e1     e2     pt1
   
5.          st1    st2       x      y
   
6.         )
   
7.   (setvar "cmdecho" 0)
   
8.   (setq    data    (toupu_select 0.1);选取线段输出数据
   
9.     data    (toupu data);进行多边形拓朴，输出拓朴后多边形关系
   
10.     pt_lst    (car data)
    
11.     n_pt    (length pt_lst)
    
12.     dbx_lst    (nth 1 data)
    
13.     n_dbx    (length dbx_lst)
    
14.     gx_lst    (nth 2 data)
    
15.   )
    
16.   ;;展点
    
17.   (setq i 0)
    
18.   (repeat n_pt
    
19.     (command "text" (nth i pt_lst) 0.5 0 (rtos i 2) "")
    
20.     (setq i (1+ i))
    
21.   )
    
22.   ;;绘每一个多边形
    
23.   (setq i 0)
    
24.   (repeat n_dbx
    
25.     (setq dbx     (nth i dbx_lst)
    
26.       k     (length dbx)
    
27.       j     0
    
28.       dbx_po nil
    
29.     )
    
30.     ;;生成多边形的坐标数据表
    
31.     (repeat k
    
32.       (setq dbx_po (append dbx_po (list (nth (nth j dbx) pt_lst)))
    
33.         j       (1+ j)
    
34.       )
    
35.     )
    
36.     ;;根据多边形数据表生成多边形
    
37.     (makepline dbx_po 1 0 nil)
    
38.     (setq e1  (entlast)
    
39.       pt1 (in_point_dbx dbx_po)    ;生成多边形内一点，用来标注多边形序号
    
40.     )
    
41.     (command "text" pt1 1.5 0 (rtos i 2) "") ;注记多边形序号
    
42.     (setq e2 (entlast))
    
43.     (vla-put-color (vlax-ename->vla-object e2) acred)
    
44.     ;;编无组
    
45.     (vl-cmdf "-group" "create" "*" "" e1 e2 "")
    
46.     (setq i (1+ i))
    
47.   )
    
48.   ;;写出多边关系表
    
49.   (setq    i  0
    
50.     pt (getpoint "\n选择显示多边形关系表的地方:")
    
51.     x  (nth 0 pt)
    
52.     y  (nth 1 pt)
    
53.   )
    
54.   (repeat n_dbx
    
55.     (setq pt1 (list x (- y (* i 14)) 0)
    
56.       st1 (car (nth i gx_lst))
    
57.       st1 (vl-prin1-to-string st1)
    
58.     )
    
59.     (command "text" pt1 2 0 (strcat (rtos i 2) "(") "")
    
60.     (setq pt1 (list (+ 5 x) (- y (* i 14) 3) 0))
    
61.     (command "text" pt1 2 0 st1 "")
    
62.     (setq pt1 (list (+ 5 x) (- y (* i 14) 7) 0)
    
63.       st1 (nth 1 (nth i gx_lst))
    
64.       st1 (vl-prin1-to-string st1)
    
65.     )
    
66.     (command "text" pt1 2 0 st1 "")
    
67.     (setq pt1 (list x (- y (* i 14) 11) 0))
    
68.     (command "text" pt1 2 0 ")" "")
    
69. 
    
70.     (setq i (1+ i))
    
71.   )
    
72. )
    

<br /> (defun c:test (/        data   n      i     k    j      pt_lst dbx_lst<br />          gx_lst dbx       dbx_po n_pt     n_dbx    e1     e2     pt1<br />          st1    st2       x      y<br />         )<br />   (setvar "cmdecho" 0)<br />   (setq    data    (toupu_select 0.1);选取线段输出数据<br />     data    (toupu data);进行多边形拓朴，输出拓朴后多边形关系<br />     pt_lst    (car data)<br />     n_pt    (length pt_lst)<br />     dbx_lst    (nth 1 data)<br />     n_dbx    (length dbx_lst)<br />     gx_lst    (nth 2 data)<br />   )<br />   ;;展点<br />   (setq i 0)<br />   (repeat n_pt<br />     (command "text" (nth i pt_lst) 0.5 0 (rtos i 2) "")<br />     (setq i (1+ i))<br />   )<br />   ;;绘每一个多边形<br />   (setq i 0)<br />   (repeat n_dbx<br />     (setq dbx     (nth i dbx_lst)<br />       k     (length dbx)<br />       j     0<br />       dbx_po nil<br />     )<br />     ;;生成多边形的坐标数据表<br />     (repeat k<br />       (setq dbx_po (append dbx_po (list (nth (nth j dbx) pt_lst)))<br />         j       (1+ j)<br />       )<br />     )<br />     ;;根据多边形数据表生成多边形<br />     (makepline dbx_po 1 0 nil)<br />     (setq e1  (entlast)<br />       pt1 (in_point_dbx dbx_po)    ;生成多边形内一点，用来标注多边形序号<br />     )<br />     (command "text" pt1 1.5 0 (rtos i 2) "") ;注记多边形序号<br />     (setq e2 (entlast))<br />     (vla-put-color (vlax-ename->vla-object e2) acred)<br />     ;;编无组<br />     (vl-cmdf "-group" "create" "*" "" e1 e2 "")<br />     (setq i (1+ i))<br />   )<br />   ;;写出多边关系表<br />   (setq    i  0<br />     pt (getpoint "\n选择显示多边形关系表的地方:")<br />     x  (nth 0 pt)<br />     y  (nth 1 pt)<br />   )<br />   (repeat n_dbx<br />     (setq pt1 (list x (- y (* i 14)) 0)<br />       st1 (car (nth i gx_lst))<br />       st1 (vl-prin1-to-string st1)<br />     )<br />     (command "text" pt1 2 0 (strcat (rtos i 2) "(") "")<br />     (setq pt1 (list (+ 5 x) (- y (* i 14) 3) 0))<br />     (command "text" pt1 2 0 st1 "")<br />     (setq pt1 (list (+ 5 x) (- y (* i 14) 7) 0)<br />       st1 (nth 1 (nth i gx_lst))<br />       st1 (vl-prin1-to-string st1)<br />     )<br />     (command "text" pt1 2 0 st1 "")<br />     (setq pt1 (list x (- y (* i 14) 11) 0))<br />     (command "text" pt1 2 0 ")" "")<br /> <br />     (setq i (1+ i))<br />   )<br /> )<br />

大家有兴趣后再发源码

雨箭风刀

很感兴趣，有没有形象点的图示？

xiao_longxin

请看要录像

雨箭风刀

能否把相关函数打包做成一个fas或vlx供测试？

xiao_longxin

已打包，请到一楼最后下载

xiao_longxin

已经对程序进行了改进，支持PLINE和LINE，并修正了有些多边形带小尾巴的Bug，命令名：TEST[/COLOR]

xiao_longxin

再次对多边形关系进行了优化，为以后处理孤岛作好了准备

caddog

我下了，运行时选择了对象之后提示　参数类型错误: consp nil
不知为何呢

xiao_longxin

我这里没有这个问题，但不知是不是上传错了没有修改的，现在再上传上来，前面的也重新上传了

xyz518mm

真是厉害阿,不知道xiao_longxin 您的这个"toupu"函数是否可提供源码供研究?
谢谢~

雨箭风刀

ssbr  曲线交点打断
sstopu  曲线交点打断生成面域

雨箭风刀

两个命令均支持 所有曲线(闭合&非闭合)
spline,*polyline,line,arc,circle,ellipse

xiao_longxin

风雨兄应该做成函数，返回的是所生的面域的选择集，以方便别人可以进一步编程

eachy

最初由 雨箭风刀 发布
[B]ssbr  曲线交点打断
sstopu  曲线交点打断生成面域 [/B]

这几天正在重写这个曲线交点断开，目前完成了 Line、Arc、Circle、Ellipse、Spline，还差 *Polyline。简单测试了下 200 根 Line 组成的网格 10000 个交点，用时 8.55 s。上面的附件无法下载，不知道你这个程序的效率如何。

aeo

最初由 eachy 发布
[B]
这几天正在重写这个曲线交点断开，目前完成了 Line、Arc、Circle、Ellipse、Spline，还差 *Polyline。简?.. [/B]

用的entmod 还是command