TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: well20152016 on December 03, 2018, 03:12:31 AM

Title: Fast algorithm for finding 3D face boundary?
Post by: well20152016 on December 03, 2018, 03:12:31 AM

Fast algorithm for finding 3D face boundary?

Title: Re: Fast algorithm for finding 3D face boundary?
Post by: David Bethel on December 03, 2018, 05:50:42 AM

Isn't a 3DFACE is a boundary in most instances ???

Title: Re: Fast algorithm for finding 3D face boundary?
Post by: ribarm on December 03, 2018, 10:02:34 AM

Hi this is improved version that accepts holes in 3dfaces network and manages to do breaking along boundary - 3DPOLYLINE if user want that... But nevertheless its slow - on my PC it took 920 secsonds for your cca 2500 3dfaces...

Code - Auto/Visual Lisp: [Select]

1. (defun c:3dpolysaround3dfaces ( / vl-position-fuzz car-vl-member-if unique uniquepl osm pdm pds ss ti i 3df pl pll plll el ell elll k z p1 p2 3dppl ch pp ppl pos1 pos2 ppp 3dppls p )
2.  
3.   ;; (vl-position-fuzz 3.29 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9) 0.01) => 2 ;;
4.   (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
5.     (defun car-vl-member-if ( f l / ff r )
6.       (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
7.       (vl-some ff l)
8.       r
9.     )
10.     (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
11.   )
12.  
13.   (defun car-vl-member-if ( f l / ff r )
14.     (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
15.     (vl-some ff l)
16.     r
17.   )
18.  
19.   (defun unique ( l )
20.     (if l (cons (car l) (unique (vl-remove-if '(lambda ( x )
21.       (and
22.         (vl-some '(lambda ( y ) (equal y (car (car l)) 1e-6)) x)
23.         (vl-some '(lambda ( y ) (equal y (cadr (car l)) 1e-6)) x)
24.         (vl-some '(lambda ( y ) (equal y (caddr (car l)) 1e-6)) x)
25.         (vl-some '(lambda ( y ) (equal y (cadddr (car l)) 1e-6)) x)
26.       )) l))))
27.   )
28.  
29.   (defun uniquepl ( l )
30.     (if l (cons (car l) (uniquepl (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))))
31.   )
32.  
33.   (setq osm (getvar 'osmode))
34.   (setq pdm (getvar 'pdmode))
35.   (setq pds (getvar 'pdsize))
36.   (setvar 'pdmode 35)
37.   (setvar 'pdsize -1.5)
38.   (prompt "\nSelect 3DFACE entities to process...")
39.   (setq ss (ssget '((0 . "3DFACE"))))
40.   (if ss
41.     (progn
42.       (setq ti (car (_vl-times)))
43.       (repeat (setq i (sslength ss))
44.         (setq 3df (ssname ss (setq i (1- i))))
45.         (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
46.         (setq pll (cons pl pll))
47.       )
48.       (setq plll (vl-remove-if '(lambda ( x ) (<= (length (uniquepl x)) 2)) pll))
49.       (setq plll (unique plll))
50.       (foreach pl plll
51.         (setq el (mapcar '(lambda ( a b ) (list a b)) pl (cdr (reverse (cons (car pl) (reverse pl))))))
52.         (setq ell (append el ell))
53.       )
54.       (setq ell (vl-remove-if '(lambda ( x ) (equal (apply 'distance x) 0.0 1e-6)) ell))
55.       (setq k -1 elll ell)
56.       (foreach e1 ell
57.         (setq k (1+ k) z nil)
58.         (foreach e2 (vl-remove nil (mapcar '(lambda ( x ) (if (null z) (setq z 0) (setq z (1+ z))) (if (/= k z) x)) ell))
59.           (if (or (equal e1 e2 1e-6) (equal e1 (reverse e2) 1e-6))
60.             (setq elll (vl-remove e1 elll))
61.           )
62.         )
63.       )
64.       (while elll
65.         (setq el (car elll))
66.         (setq p1 (car el) p2 (cadr el))
67.         (setq 3dppl (cons p1 3dppl))
68.         (setq elll (cdr elll))
69.         (while (setq el (car-vl-member-if '(lambda ( x ) (or (equal p2 (car x) 1e-6) (equal p2 (cadr x) 1e-6))) elll))
70.           (if (equal (car el) p2 1e-6)
71.             (setq p1 (car el) p2 (cadr el))
72.             (setq p1 (cadr el) p2 (car el))
73.           )
74.           (setq elll (vl-remove el elll))
75.           (setq 3dppl (cons p1 3dppl))
76.         )
77.         (prompt "\nPRESS ANY KEY TO CONTINUE...")
78.         (vl-catch-all-apply 'grread)
79.         (foreach p 3dppl
80.           (setq pp (entmakex (list '(0 . "POINT") (cons 10 p))))
81.           (redraw pp 3)
82.           (vl-cmdf "_.DELAY" 100)
83.           (entdel pp)
84.         )
85.         (initget "Yes No")
86.         (setq ch (getkword "\nPick breaking points in shown direction or draw closed 3DPOLYLINE [Yes/No] <Yes> : "))
87.         (if (null ch)
88.           (setq ch "Yes")
89.         )
90.         (if (= ch "Yes")
91.           (progn
92.             (setvar 'osmode 1)
93.             (while (setq pp (getpoint "\nPick or specify breaking point - ENTER TO FINISH (at least 2 points on contour must be specified in shown direction) : "))
94.               (setq ppl (cons pp ppl))
95.             )
96.             (setq ppl (reverse ppl))
97.             (setq 3dppl (append 3dppl 3dppl))
98.             (setq ppl (mapcar '(lambda ( a b ) (list a b)) ppl (cdr (reverse (cons (car ppl) (reverse ppl))))))
99.             (foreach pp ppl
100.               (setq pos1 (vl-position-fuzz (car pp) 3dppl 1e-6) pos2 (vl-position-fuzz (cadr pp) 3dppl 1e-6) k -1)
101.               (if (< pos2 pos1)
102.                 (setq pos2 (+ pos2 (vl-position-fuzz (cadr pp) (cdr (vl-member-if '(lambda ( x ) (equal x (cadr pp) 1e-6)) 3dppl)) 1e-6) 1))
103.               )
104.               (foreach p 3dppl
105.                 (setq k (1+ k))
106.                 (if (<= pos1 k pos2)
107.                   (setq ppp (cons p ppp))
108.                 )
109.               )
110.               (setq 3dppls (cons ppp 3dppls))
111.               (setq ppp nil)
112.             )
113.             (foreach ppp 3dppls
114.               (vl-cmdf "_.3DPOLY")
115.               (foreach p ppp
116.                 (vl-cmdf "_non" p)
117.               )
118.               (vl-cmdf "")
119.             )
120.             (setq 3dppl nil 3dppls nil ppl nil)
121.           )
122.           (progn
123.             (setq 3dppl (cons p2 3dppl))
124.             (vl-cmdf "_.3DPOLY")
125.             (foreach p 3dppl
126.               (vl-cmdf "_non" p)
127.             )
128.             (vl-cmdf "_C")
129.             (setq 3dppl nil)
130.           )
131.         )
132.       )
133.     )
134.   )
135.   (setvar 'osmode osm)
136.   (setvar 'pdmode pdm)
137.   (setvar 'pdsize pds)
138.   (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds...")
139.   (princ)
140. )
141.  

For more info, serach this topic...
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/draw-3dpoly-in-3dfaces/m-p/7789616#M365239

Regards, M.R.
P.S. You could ask someone that work in .NET or ObjectARX like nullptr-aka Daniel to convert this lisp to something faster as it's not fast algorithm at all...
But it's LISP and you can understand it...

Title: Re: Fast algorithm for finding 3D face boundary?
Post by: well20152016 on December 03, 2018, 11:01:23 PM

Thank you!