终于给我找到了，哈哈，好东西啊
好东西，学习了！！！
Gu_xl 发表于 2011-1-26 19:48 static/image/common/back.gif
优化算法后的代码：
请问版主一个问题:
最后一步"根据生成的多边形拓扑表绘制多边形",函数名是: gxl-DrawPolyLine
其中 您是如何构建出来多边形的? 是把弧段pedit吗? 还是按照坐标点绘制的呢?
我拿了一个很大的数据测试,其中面有大概 800多个的样子
最后发现,有的面 和原来的 line 线 不重合,有缝隙......
miraclelll 发表于 2012-9-13 15:38 static/image/common/back.gif
请问版主一个问题:
最后一步"根据生成的多边形拓扑表绘制多边形",函数名是: gxl-DrawPolyLine
其中 您 ...
问题已解决
版主的最后构建多边形的函数, 无法知道原因
我自己写了一段替代的代码, 使用entmake的方式,就不会有缝隙产生了
ps: 版主, 外包多边形的删除,效率太慢了, 可以优化的
去年我看到这个帖子的时候就为之一震，认为这是一个绝好的算法，划分有限元网格十分方便，但当时缺少很多子函数就没有研究了，不知道这次补全了没？
miraclelll 发表于 2012-9-19 15:35
问题已解决
版主的最后构建多边形的函数, 无法知道原因
能否把你的替代代码发上来分享下，也请版主出来探讨下，能不能打造出一个精品来！…
本帖最后由 miraclelll 于 2012-9-20 10:31 编辑
tm20038175 发表于 2012-9-20 00:00 http://bbs.mjtd.com/static/image/common/back.gif
能否把你的替代代码发上来分享下，也请版主出来探讨下，能不能打造出一个精品来！…
哦,对不起, 忘记附上去了.... 以下是我优化后的 删除外包多边形
原来的思路是: 将每一个多边形和其他比他面积小的多边形 进行比较判断是否是 需要删除的错误图形( 函数 PolyInLwpolyLine)
循环次数 为 n*(n-1)/2
其中判断 这个是否为删除的错误图形 , 需要花费些时间,特别是节点很多的情况
优化后的思路是: 在进行判断是否需要删除的图形之前, 判断其是否有公边, 如果没有公边,就不要进去去判断了,肯定不是错误的图形, 然后如果判断为错误图形,就不需要拿这个图形继续和其他比较了
循环次数, 会有所降低
主要省的时间在于:判断是否是 需要删除的错误图形( 函数 PolyInLwpolyLine) 这个函数不需要进行 N*(N-1)/2 次
ps: 如果图形比较简单,其实优化与否没有关系, 但是如果需要构建的图形比较多的情况,就会看到省了很多时间. 我测试的数据是: 近1000 的图形需要构建,初始传入的 line线 有3000 多. 时间降低到1/3
附上代码: ;;; 删除外包多边形;;;
(defun gxl-DelOutPolyline (ss0 / ssL ssL1 ent flag en1 rtn n i j en )
(princ "\n 删除外包多边形... ... ")
(setq t7 (getvar "cdate"))
(setq rtn (ssadd)
flag nil
)
(setq ss (vl-sort ss0 '(lambda (e1 e2) (> (GXL-GETAREA (car e1)) (GXL-GETAREA (car e2))))))
(setq ssl (mapcar 'car ss)
numlist (mapcar 'cadr ss)
)
(setq n (length ssl) i 0)
(setq m (length polytopolst) j 0)
(GXL-SYS-PROGRESS-INIT "删除外包多边形" n)
(while (< i n)
(setq en (nth i ssl)
num (nth i numlist)
numlist2 (member num numlist) ;;; 面积小的图元序号列表;
)
(setq topopoly (nth num polytopolst))
(foreach topo topopoly
(setq mn (length numlist2))
(setq j 1)
(while (and (< j mn) (= flag nil))
(setq num2 (nth j numlist2))
(setq poly (nth num2 polytopolst))
(setq poly (mapcar 'abs poly))
(if (and (/= j num)
(member (abs topo) poly)
)
(progn
(setq en1 (car (nth num2 ss0)))
(if (PolyInLwpolyLine en1 en)
(setq flag t)
);_if
)
);_if
(setq j (1+ j))
); _foreach
); _foreach
(if flag (progn (vl-remove (nth i ss) ss) (entdel en)(setq flag nil)))
(setq i (1+ i))
(GXL-SYS-PROGRESSn -1)
)
(GXL-SYS-PROGRESS-DONE)
(GXL-SYS-TIMEOUT t7)
ss
)
tm20038175 发表于 2012-9-19 23:57 static/image/common/back.gif
去年我看到这个帖子的时候就为之一震，认为这是一个绝好的算法，划分有限元网格十分方便，但当时缺少很多子 ...
里面还是缺少一些 函数, 但是不影响主线
我是自己补上去的
miraclelll 发表于 2012-9-20 10:36
里面还是缺少一些 函数, 但是不影响主线
我是自己补上去的
谢谢分享，缺函数很讨厌呀，你能做到自己补函数确实很了不起呀，其他人可不一定有这个本领了，呵呵。。。
要是能把缺的函数也补全，那程序就完美了，不知道这是不是版主的原意。。
建议大家研究下这个帖子，在划分单元时候很实用，也十分感谢miraclelll的完善和优化…