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:
Triangulation
« previous
next »
Print
Pages:
1
2
3
[
4
]
All
|
Go Down
Author
Topic: Triangulation (Read 13027 times)
0 Members and 2 Guests are viewing this topic.
ymg
Guest
Re: Triangulation
«
Reply #45 on:
February 03, 2014, 01:20:20 AM »
Bullah,
Your modified code was working. However a point does not show much unless you
change DDPTYPE.
Here I have modified so that the points are entmake'd and kept the list in the command line:
Code - Auto/Visual Lisp:
[Select]
;; Given the ename of a 3DFACE ;
;; Returns List of 3 unique points forming that face ;
(
defun
3df
->
pl
(
en
)
(
defun
distinct
(
l
)
(
if
l
(
cons
(
car
l
)
(
distinct
(
vl-remove
(
car
l
)
l
)
)
)
)
)
(
setq
ent
(
entget
en
)
l
(
distinct
(
mapcar
'
(
lambda
(
a
)
(
cdr
(
assoc
a ent
)
)
)
'
(
10
11
12
13
)
)
)
)
)
;; Given 2 List ;
;; Returns List of Elements Common to Both List. ;
(
defun
common
(
l1 l2
)
(
if
l1
(
if
(
member
(
car
l1
)
l2
)
(
cons
(
car
l1
)
(
common
(
cdr
l1
)
l2
)
)
(
common
(
cdr
l1
)
l2
)
)
)
)
;; Given a Selection Set of Entities ;
;; Returns List of ename ;
(
defun
ss
->
enl
(
ss
/
i l
)
(
if
ss
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
l
(
cons
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
l
)
)
)
)
)
(
defun
crossproduct
(
u v
)
(
list
(
-
(
*
(
cadr
u
)
(
caddr
v
)
)
(
*
(
cadr
v
)
(
caddr
u
)
)
)
(
-
(
*
(
car
v
)
(
caddr
u
)
)
(
*
(
car
u
)
(
caddr
v
)
)
)
(
-
(
*
(
car
u
)
(
cadr
v
)
)
(
*
(
car
v
)
(
cadr
u
)
)
)
)
)
(
defun
getz
(
p p1 p2 p3
/
n
)
(
setq
p
(
list
(
car
p
)
(
cadr
p
)
0
.
)
n
(
crossproduct
(
mapcar
'
-
p2 p1
)
(
mapcar
'
-
p3 p1
)
)
)
(
list
(
car
p
)
(
cadr
p
)
(
/
(
apply
'
+
(
mapcar
'
*
n
(
mapcar
'
-
p1 p
)
)
)
(
caddr
n
)
)
)
)
;; Return the maximum extent along the X of Selection Set of 3DFACE ;
(
defun
maxtr
(
ss
/
i ent tmp bb rtn
)
(
setq
rtn
0
)
(
repeat
(
setq
i
(
sslength
ss
)
)
(
setq
ent
(
entget
(
ssname
ss
(
setq
i
(
1-
i
)
)
)
)
tmp
(
mapcar
'
(
lambda
(
a
)
(
cdr
(
assoc
a ent
)
)
)
'
(
10
11
12
13
)
)
bb
(
list
(
apply
'
mapcar
(
cons
'
min
tmp
)
)
(
apply
'
mapcar
(
cons
'
max
tmp
)
)
)
rtn
(
max
rtn
(
-
(
caadr
bb
)
(
caar
bb
)
)
)
)
)
)
;|
Función zpto
|;
(
defun
c:zpto
(
/
p enl enl1 enl2 tr
)
(
setvar
"osmode"
0
)
(
setq
maxt
(
maxtr
(
ssget
"_X"
'
(
(
0
.
"3DFACE"
)
)
)
)
)
(
while
(
setq
p
(
getpoint
"
\n
Pick a Point: "
)
)
;Searching For The Repeated 3DFACE
(
setq
enl1
(
ss
->
enl
(
ssget
"_F"
(
list
p
(
list
(
+
(
car
p
)
maxt
)
(
cadr
p
)
)
)
'
(
(
0
.
"3DFACE"
)
)
)
)
enl2
(
ss
->
enl
(
ssget
"_F"
(
list
p
(
list
(
-
(
car
p
)
maxt
)
(
cadr
p
)
)
)
'
(
(
0
.
"3DFACE"
)
)
)
)
)
(
cond
(
(
setq
enl
(
common enl1 enl2
)
)
(
setq
tr
(
3df
->
pl
(
car
enl
)
)
p
(
getz p
(
car
tr
)
(
cadr
tr
)
(
caddr
tr
)
)
)
(
entmakex
(
list
'
(
0
.
"POINT"
)
(
cons
10
p
)
)
)
(
princ
"
\n
Point on 3dFace: "
)
(
princ
p
)
)
(
t
(
princ
"
\n
Point is Outside of TIN"
)
)
)
)
)
«
Last Edit: February 03, 2014, 02:33:37 AM by ymg
»
Logged
bullah
Guest
Re: Triangulation
«
Reply #46 on:
February 04, 2014, 10:48:51 PM »
"terima kasih tuan" thank you sir
Logged
ymg
Guest
Re: Triangulation
«
Reply #47 on:
February 04, 2014, 11:29:01 PM »
Terima kasih kembali, Bullah
Logged
Print
Pages:
1
2
3
[
4
]
All
|
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Triangulation