Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
snowman.hms

Generate Non-Overlapping Polygons From A Set Of [Lwpoly]Lines

Các bài được khuyến nghị

Doan Van Ha    2.676

Hồi trước có đọc thuật toán về thứ này nhưng chưa đụng vào công việc nên chưa nghiên cứu.

Gởi bạn xem liệu có tốt hơn không nhé

http://www.cadviet.com/upfiles/7/67029_12epcgpolygondetection.pdf?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
snowman.hms    30

i've Fixed the bugs.

new result be:

Command: tt
Select objects:
 Time to Get Edges : 16.00 ms.
 Time to calculate edges : 6599 ms
 Times to process edges : 7285.0000 ms
Number of vertex: 22772.
Number of Edges : 45006.
 Times to calculate polygons : 20390.0000 ms
 Times to Create polygons : 9578.0000 ms
 Total time is : 46754.0000 ms
Total: 22235 polygons found./
 
Chỉnh sửa theo snowman.hms

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
snowman.hms    30

(defun _getedges (lst / e enx l typ 3d->2d dxf t0)
(defun 3d->2d (3dpt) (list (car 3dpt) (cadr 3dpt)))
(defun dxf (i el) (cdr (assoc i el)))
(setq t0 (getvar "MilliSecs"))
(foreach e lst
(setq enx (entget e))
(cond ((= (setq typ (dxf 0 enx)) "LINE")
(setq l (cons (list (list (3d->2d (dxf 10 enx)) (3d->2d (dxf 11 enx)))) l))
)
((= typ "LWPOLYLINE") (setq l (cons (_Lw2Params enx) l)))
)
)
(princ (strcat "\n\tTime to Get Edges : " (rtos (- (getvar "MilliSecs") t0) 2 2) " ms."))
(apply (function append) l)
)
(defun _Lw2Params (el / caaddddr cdaddddr rtn cls)
(defun caaddddr (l) (caar (cddddr l)))
(defun cdaddddr (l) (cdar (cddddr l)))
(if (= 1 (cdr (assoc 70 el)))
(setq cls t)
)
(setq el (member (assoc 10 el) el))
(while (= 10 (caaddddr el))
(setq rtn (cons (list (cdar el) (cdaddddr el)) rtn)
el (cddddr el)
)
)
(if cls
(setq rtn (cons (list (cdar el) (car (last rtn))) rtn))
)
(reverse rtn)
)
(defun _sortxy (l)
(vl-sort l
(function (lambda (a b)
(if (equal (car a) (car b) 1e-3)
(<= (cadr a) (cadr b))
(< (car a) (car b))
)
)
)
)
)
(defun LM:Unique ( l / x r )
(while l
(setq x (car l)
l (vl-remove x (cdr l))
r (cons x r)
)
)
(reverse r)
)
(defun ff1 (l fuz / e e1 l1 l2 t0 p a)
(setq t0 (getvar "MilliSecs")
a (/ 1 fuz)
)
(foreach e l (setq l1 (cons (_sortxy e) l1)))
(setq l (vl-sort l1 (function (lambda (a b) (<= (caar a) (caar b)))))
l1 nil
)
(while (setq e (car l))
(setq l (cdr l))
(while (and (setq e1 (car l)) (>= (car (last e)) (caar e1)))
(setq l (cdr l))
(if (setq p (inters (car e) (last e) (car e1) (last e1)))
(setq e (vl-list* (car e) p (cdr e))
e1 (vl-list* (car e1) p (cdr e1))
)
)
(setq l1 (cons e1 l1))
)
(if l1
(progn (foreach a l1 (setq l (cons a l)))
(setq l2 (cons (_UniqueFuzz (_sortxy e) fuz) l2)
l1 nil
)
)
(setq l2 (cons (_UniqueFuzz (_sortxy e) fuz) l2))
)
)
(setq l2 (apply (function append) (mapcar (function _grouppair) l2))
l2 (vl-sort l2 (function (lambda (a b) (<= (caar a) (caar b)))))
l1 nil
)
(setq l2 (mapcar (function
(lambda (x)
(mapcar (function (lambda (p) (list (/ (fix (* (car p) a)) a) (/ (fix (* (cadr p) a)) a)))) x)
)
)
l2
)
)
(setq l2 (_UniqueFuzz l2 fuz))
(princ "\n\tTime to calculate edges : ")
(princ (- (getvar "MilliSecs") t0))
(princ " ms\n")
l2
)
(defun _grouppair (l / r)
(if (cdr l)
(cons (list (car l) (cadr l)) (_grouppair (cdr l)))
)
)
(defun _UniqueFuzz (l f / x r)
;; l - list of "sorted" edges
(while (setq x (car l))
(setq l (cdr l))
(while (and l (equal x (car l) fuz)) (setq l (cdr l)))
(cond ((equal (car x) (cadr x) fuz))
((setq r (cons x r)))
)
)
(reverse r)
)
(defun sort_adj-ccw (p l lp / ang<2pi pi/2)
(defun ang<2pi (a) (rem (+ pi pi a) (+ pi pi)))
(setq p (nth p lp)
l (mapcar '(lambda (x) (cons x (nth x lp))) l)
pi/2 (/ pi 2.)
)
(mapcar 'car
(vl-sort l
(function
(lambda (x y) (< (ang<2pi (+ pi/2 (angle p (cdr x)))) (ang<2pi (+ pi/2 (angle p (cdr y))))))
)
)
)
)
(defun safearray-get (ar i) (read (vlax-safearray-get-element ar i)))
(defun safearray-put (ar i v) (vlax-safearray-put-element ar i (vl-prin1-to-string v)))
(defun get-neighbors (p GB) (safearray-get GB p))
(defun remove-neighbor (p n GB) (safearray-put GB p (vl-remove n (safearray-get GB p))))
(defun remove-chain (l GB / a b)
(if (setq a (car l))
(progn (foreach b (get-neighbors a GB)
(remove-neighbor a b GB)
(remove-neighbor b a GB)
(if (not (cadr (vl-remove a (get-neighbors b GB))))
(remove-chain (cons b (cdr l)) GB)
(remove-chain (cdr l) GB)
)
)
)
)
)
(defun nth- (a l)
(if (= a (car l))
(last l)
(nth (1- (vl-position a l)) l)
)
)
(defun f1 (a GB / a1 c c1 l1 l2 CC)
(if (and (setq l1 (get-neighbors a GB)) (cadr l1))
(progn (setq a1 a
l2 l1
)
(while (cadr l1)
(setq b (car l1)
a a1
c1 (list b a)
l1 (cdr l1)
)
(while (and (setq c (get-neighbors b GB)) (setq c (nth- a c)) (/= c (car l1)) (not (vl-position c c1)))
(setq c1 (cons c c1)
a b
b c
)
)
(if (and (>= (length c1) 2) (= (car l1) c))
(setq c1 (cons (car l1) c1)
cc (cons c1 cc)
)
)
)
(mapcar '(lambda (x)
(remove-neighbor x a1 GB) ;(remove-neighbor a1 x GB)
)
l2
)
)
)
cc
)
(defun f2 (le / lp lpi l1 l2 l3 l4 p t0)
(setq t0 (getvar "MilliSecs"))
(setq le (vl-sort le
(function (lambda (x y)
(if (equal (caar x) (caar y) 1e-3)
(<= (cadar x) (cadar y))
(< (caar x) (caar y))
)
)
)
)
lp (apply (function append) le)
lp (vl-sort lp
(function (lambda (x y)
(if (= (car x) (car y))
(<= (cadr x) (cadr y))
(< (car x) (car y))
)
)
)
)
l1 nil
)
(while (setq p (car lp))
(if (equal p (car l1) 1e-3)
(setq lp (cdr lp))
(setq l1 (cons p l1)
lp (cdr lp)
)
)
)
(setq lp (reverse l1)
lpi (vl-sort-i lp
(function (lambda (x y)
(if (= (car x) (car y) )
(<= (cadr x) (cadr y))
(< (car x) (car y))
)
)
)
)
l4 lp
l1 (mapcar (function car) le)
l2 (mapcar (function cadr) le)
l1 (f3 l1 lp)
l2 (f3 l2 lp)
le (mapcar (function list) l1 l2)
)
(princ (strcat "\n\tTime to process edges : "
(rtos (- (getvar "MilliSecs") t0))
" ms\n"
)
)
(list lp lpi le)
)
(defun f3 (l1 l2 / p i j l3 li)
(setq li (vl-sort-i l1
(function (lambda (x y)
(if (= (car x) (car y) )
(<= (cadr x) (cadr y))
(< (car x) (car y))
)
)
)
)
l1 (vl-sort l1
(function (lambda (x y)
(if (= (car x) (car y) )
(<= (cadr x) (cadr y))
(< (car x) (car y))
)
)
)
)
i 0
l3 nil
)
(while (setq j 0
p (car l1)
)
(while (and (equal (car p) (caar l1) 1e-3)
(equal (cadr p) (cadar l1) 1e-3)
)
(setq j (1+ j)
l1 (cdr l1)
)
)
(while (if (equal (car p) (caar l2) 1e-2)
(not (equal (cadr p) (cadar l2) 1e-2))
t
)
(setq i (1+ i)
l2 (cdr l2)
)
)
(repeat j (setq l3 (cons i l3)))
)
(mapcar (function cdr)
(vl-sort (mapcar (function cons) li (reverse l3))
(function (lambda (a b) (<= (car a) (car b))))
)
)
)
(defun _Lwpoly (lr lst cl)
(entmakex (apply 'append
(list (list '(0 . "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 8 lr)
(cons 62 cl)
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(cons 38 (caddr (trans '(0 0 0) 1 (trans '(0. 0. 1.) 1 0))))
(cons 70 1)
)
(mapcar '(lambda (x) (list 10 (car x) (cadr x))) lst)
(list (cons 210 (trans '(0. 0. 1.) 1 0)))
)
)
)
)
(defun c:tt (/ l lp lpi le c cc t0 t1 t2 n GB GD GV i n tm)
(progn (repeat 3 (gc))
(setq t0 (getvar "MilliSecs")
L (F2
(ff1 (_getedges (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex (ssget))))) 1e-3)
)
t1 (getvar "MilliSecs")
lp (car l)
lpi (cadr l)
le (caddr l)
cc nil
c nil
)
(princ (strcat "\nNumber of vertex: " (itoa (length lp)) "."))
(princ (strcat "\nNumber of Edges : " (itoa (length le)) "."))
(setq n (length lpi)
GB (vlax-make-safearray vlax-vbstring (cons 0 (1- n)))
)
(mapcar (function (lambda (x y)
(safearray-put GB x (cons y (safearray-get GB x)))
(safearray-put GB y (cons x (safearray-get GB y)))
)
)
(mapcar (function car) le)
(mapcar (function cadr) le)
)
(setq lb (mapcar (function read) (vlax-safearray->list GB))
i -1
tm nil
)
(repeat n (setq i (1+ i)) (setq tm (cons (sort_adj-ccw i (nth i lb) lp) tm)))
(setq lb (reverse tm)
tm nil
i -1
)
(mapcar (function (lambda (x) (safearray-put GB (setq i (1+ i)) x))) lb)
(if (setq i -1
tm (vl-remove nil
(mapcar (function (lambda (x)
(setq i (1+ i))
(if (= (length x) 1)
i
)
)
)
lb
)
)
)
(remove-chain tm GB)
)
(foreach p lpi (setq c (f1 p GB)) (setq cc (cons c cc)))
(princ (strcat "\n\tTime to calculate polygons : " (rtos (- (setq t2 (getvar "MilliSecs")) t1)) " ms\n"))
(if cc
(progn (setq cc (vl-remove nil (apply 'append cc)))
(mapcar (function (lambda (c) (_Lwpoly "tmpp" (mapcar '(lambda (x) (nth x lp)) c) 44))) cc)
(princ (strcat "\n\tTime to Create polygons : " (rtos (- (getvar "MilliSecs") t2)) " ms\n"))
(princ (strcat "\n\tTotal time is : " (rtos (- (getvar "MilliSecs") t0)) " ms\n"))
(princ (strcat "\nTotal: " (itoa (length cc)) " polygons found./"))
)
(princ "\nThere is no Cycle found!")
)
)
(princ)
)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×