Welcome,
Guest
. Please
login
or
register
.
1 Hour
1 Day
1 Week
1 Month
Forever
Login with username, password and session length
News:
Home
Help
Login
Register
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Fast algorithm for finding 3D face boundary?
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: Fast algorithm for finding 3D face boundary? (Read 2550 times)
0 Members and 1 Guest are viewing this topic.
well20152016
Newt
Posts: 130
Fast algorithm for finding 3D face boundary?
«
on:
December 03, 2018, 03:12:31 AM »
Fast algorithm for finding 3D face boundary?
Logged
David Bethel
Swamp Rat
Posts: 656
WWW
Re: Fast algorithm for finding 3D face boundary?
«
Reply #1 on:
December 03, 2018, 05:50:42 AM »
Isn't a 3DFACE is a boundary in most instances
Logged
R12 Dos - A2K
ribarm
Gator
Posts: 3268
Marko Ribar, architect
WWW
Re: Fast algorithm for finding 3D face boundary?
«
Reply #2 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]
(
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
)
;; (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 ;;
(
defun
vl
-
position
-
fuzz
(
e l fuzz
/
car
-
vl
-
member
-
if
)
(
defun
car
-
vl
-
member
-
if
(
f l
/
ff r
)
(
setq
ff '
(
lambda
(
x
)
(
if
(
apply
f
(
list
x
)
)
(
setq
r x
)
)
)
)
(
vl-some
ff l
)
r
)
(
vl-position
(
car
-
vl
-
member
-
if
'
(
lambda
(
x
)
(
equal
e x fuzz
)
)
l
)
l
)
)
(
defun
car
-
vl
-
member
-
if
(
f l
/
ff r
)
(
setq
ff '
(
lambda
(
x
)
(
if
(
apply
f
(
list
x
)
)
(
setq
r x
)
)
)
)
(
vl-some
ff l
)
r
)
(
defun
unique
(
l
)
(
if
l
(
cons
(
car
l
)
(
unique
(
vl
-
remove
-
if
'
(
lambda
(
x
)
(
and
(
vl-some
'
(
lambda
(
y
)
(
equal
y
(
car
(
car
l
)
)
1e
-
6
)
)
x
)
(
vl-some
'
(
lambda
(
y
)
(
equal
y
(
cadr
(
car
l
)
)
1e
-
6
)
)
x
)
(
vl-some
'
(
lambda
(
y
)
(
equal
y
(
caddr
(
car
l
)
)
1e
-
6
)
)
x
)
(
vl-some
'
(
lambda
(
y
)
(
equal
y
(
cadddr
(
car
l
)
)
1e
-
6
)
)
x
)
)
)
l
)
)
)
)
)
(
defun
uniquepl
(
l
)
(
if
l
(
cons
(
car
l
)
(
uniquepl
(
vl
-
remove
-
if
'
(
lambda
(
x
)
(
equal
x
(
car
l
)
1e
-
6
)
)
l
)
)
)
)
)
(
setq
osm
(
getvar
'osmode
)
)
(
setq
pdm
(
getvar
'pdmode
)
)
(
setq
pds
(
getvar
'pdsize
)
)
(
setvar
'pdmode
35
)
(
setvar
'pdsize
-
1.5
)
(
prompt
"
\n
Select 3DFACE entities to process..."
)
(
setq
ss
(
ssget
'
(
(
0
.
"3DFACE"
)
)
)
)
(
if
ss
(
progn
(
setq
ti
(
car
(
_vl-times
)
)
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
3df
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
)
(
setq
pl
(
mapcar
'
cdr
(
vl
-
remove
-
if
-
not
'
(
lambda
(
x
)
(
vl-position
(
car
x
)
'
(
10
11
12
13
)
)
)
(
entget
3df
)
)
)
)
(
setq
pll
(
cons
pl pll
)
)
)
(
setq
plll
(
vl
-
remove
-
if
'
(
lambda
(
x
)
(
<=
(
length
(
uniquepl x
)
)
2
)
)
pll
)
)
(
setq
plll
(
unique plll
)
)
(
foreach
pl plll
(
setq
el
(
mapcar
'
(
lambda
(
a b
)
(
list
a b
)
)
pl
(
cdr
(
reverse
(
cons
(
car
pl
)
(
reverse
pl
)
)
)
)
)
)
(
setq
ell
(
append
el ell
)
)
)
(
setq
ell
(
vl
-
remove
-
if
'
(
lambda
(
x
)
(
equal
(
apply
'
distance
x
)
0.0
1e
-
6
)
)
ell
)
)
(
setq
k
-
1
elll ell
)
(
foreach
e1 ell
(
setq
k
(
1+
k
)
z
nil
)
(
foreach
e2
(
vl-remove
nil
(
mapcar
'
(
lambda
(
x
)
(
if
(
null
z
)
(
setq
z
0
)
(
setq
z
(
1+
z
)
)
)
(
if
(
/=
k z
)
x
)
)
ell
)
)
(
if
(
or
(
equal
e1 e2 1e
-
6
)
(
equal
e1
(
reverse
e2
)
1e
-
6
)
)
(
setq
elll
(
vl-remove
e1 elll
)
)
)
)
)
(
while
elll
(
setq
el
(
car
elll
)
)
(
setq
p1
(
car
el
)
p2
(
cadr
el
)
)
(
setq
3dppl
(
cons
p1 3dppl
)
)
(
setq
elll
(
cdr
elll
)
)
(
while
(
setq
el
(
car
-
vl
-
member
-
if
'
(
lambda
(
x
)
(
or
(
equal
p2
(
car
x
)
1e
-
6
)
(
equal
p2
(
cadr
x
)
1e
-
6
)
)
)
elll
)
)
(
if
(
equal
(
car
el
)
p2 1e
-
6
)
(
setq
p1
(
car
el
)
p2
(
cadr
el
)
)
(
setq
p1
(
cadr
el
)
p2
(
car
el
)
)
)
(
setq
elll
(
vl-remove
el elll
)
)
(
setq
3dppl
(
cons
p1 3dppl
)
)
)
(
prompt
"
\n
PRESS ANY KEY TO CONTINUE..."
)
(
vl
-
catch
-
all
-
apply
'
grread
)
(
foreach
p 3dppl
(
setq
pp
(
entmakex
(
list
'
(
0
.
"POINT"
)
(
cons
10
p
)
)
)
)
(
redraw
pp
3
)
(
vl-cmdf
"_.DELAY"
100
)
(
entdel
pp
)
)
(
initget
"Yes No"
)
(
setq
ch
(
getkword
"
\n
Pick breaking points in shown direction or draw closed 3DPOLYLINE [Yes/No] <Yes> : "
)
)
(
if
(
null
ch
)
(
setq
ch
"Yes"
)
)
(
if
(
=
ch
"Yes"
)
(
progn
(
setvar
'osmode
1
)
(
while
(
setq
pp
(
getpoint
"
\n
Pick or specify breaking point - ENTER TO FINISH (at least 2 points on contour must be specified in shown direction) : "
)
)
(
setq
ppl
(
cons
pp ppl
)
)
)
(
setq
ppl
(
reverse
ppl
)
)
(
setq
3dppl
(
append
3dppl 3dppl
)
)
(
setq
ppl
(
mapcar
'
(
lambda
(
a b
)
(
list
a b
)
)
ppl
(
cdr
(
reverse
(
cons
(
car
ppl
)
(
reverse
ppl
)
)
)
)
)
)
(
foreach
pp ppl
(
setq
pos1
(
vl
-
position
-
fuzz
(
car
pp
)
3dppl 1e
-
6
)
pos2
(
vl
-
position
-
fuzz
(
cadr
pp
)
3dppl 1e
-
6
)
k
-
1
)
(
if
(
<
pos2 pos1
)
(
setq
pos2
(
+
pos2
(
vl
-
position
-
fuzz
(
cadr
pp
)
(
cdr
(
vl
-
member
-
if
'
(
lambda
(
x
)
(
equal
x
(
cadr
pp
)
1e
-
6
)
)
3dppl
)
)
1e
-
6
)
1
)
)
)
(
foreach
p 3dppl
(
setq
k
(
1+
k
)
)
(
if
(
<=
pos1 k pos2
)
(
setq
ppp
(
cons
p ppp
)
)
)
)
(
setq
3dppls
(
cons
ppp 3dppls
)
)
(
setq
ppp
nil
)
)
(
foreach
ppp 3dppls
(
vl-cmdf
"_.3DPOLY"
)
(
foreach
p ppp
(
vl-cmdf
"_non"
p
)
)
(
vl-cmdf
""
)
)
(
setq
3dppl
nil
3dppls
nil
ppl
nil
)
)
(
progn
(
setq
3dppl
(
cons
p2 3dppl
)
)
(
vl-cmdf
"_.3DPOLY"
)
(
foreach
p 3dppl
(
vl-cmdf
"_non"
p
)
)
(
vl-cmdf
"_C"
)
(
setq
3dppl
nil
)
)
)
)
)
)
(
setvar
'osmode osm
)
(
setvar
'pdmode pdm
)
(
setvar
'pdsize pds
)
(
prompt
"
\n
Elapsed time : "
)
(
princ
(
rtos
(
/
(
-
(
car
(
_vl-times
)
)
ti
)
1000.0
)
2
50
)
)
(
prompt
" seconds..."
)
(
princ
)
)
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...
Logged
Marko Ribar, d.i.a.
(graduated engineer of architecture)
M.R. on Youtube
well20152016
Newt
Posts: 130
Re: Fast algorithm for finding 3D face boundary?
«
Reply #3 on:
December 03, 2018, 11:01:23 PM »
Thank you!
Logged
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Fast algorithm for finding 3D face boundary?