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:
Arc to torus
« previous
next »
Print
Pages: [
1
] |
Go Down
Author
Topic: Arc to torus (Read 2685 times)
0 Members and 1 Guest are viewing this topic.
Jeremy Dunn
Newt
Posts: 31
Arc to torus
«
on:
April 14, 2019, 01:08:22 PM »
I have the ename of an arc that is arbitrarily oriented in 3D, I wish to replace it with a section of a torus of tube radius r that has the same center and radius using LISP. What is the best way to go about doing this?
Logged
kpblc
Bull Frog
Posts: 396
Re: Arc to torus
«
Reply #1 on:
April 14, 2019, 01:12:36 PM »
I think you have to create circle at the start point of arc (with current normal of circle), and then extrude by path your circle.
Logged
Sorry for my English.
Lee Mac
Seagull
Posts: 12917
London, England
WWW
Re: Arc to torus
«
Reply #2 on:
April 14, 2019, 05:36:34 PM »
Consider the following function, compatible with both arcs & circles:
Code - Auto/Visual Lisp:
[Select]
;; Arc -> Torus - Lee Mac
;; ent - Arc or Circle entity
;; trd - Torus tube radius
(
defun
LM:arc
->
torus
(
ent trd
/
an1 an2 cen cir enx ocs pt1 rad reg rtn spc tcs var
)
(
setq
enx
(
entget
ent
)
rad
(
cdr
(
assoc
040 enx
)
)
)
(
if
(
and
(
<
trd rad
)
(
progn
(
if
(
=
"ARC"
(
cdr
(
assoc
000 enx
)
)
)
(
setq
an1
(
cdr
(
assoc
050 enx
)
)
an2
(
rem
(
+
pi pi
(
-
(
cdr
(
assoc
051 enx
)
)
an1
)
)
(
+
pi pi
)
)
)
(
setq
an1
0.0
an2
(
+
pi pi
)
)
)
(
setq
ocs
(
cdr
(
assoc
210
enx
)
)
cen
(
cdr
(
assoc
010 enx
)
)
pt1
(
trans
(
polar
cen an1 rad
)
ocs
0
)
tcs
(
v
^
v ocs
(
mapcar
'
-
pt1
(
trans
cen ocs
0
)
)
)
spc
(
vlax
-
ename
->
vla-object
(
cdr
(
assoc
330
enx
)
)
)
cir
(
entmakex
(
list
'
(
000 .
"CIRCLE"
)
(
cons
010
(
trans
pt1
0
tcs
)
)
(
cons
040 trd
)
(
cons
210
tcs
)
)
)
)
)
(
not
(
vl-catch-all-error-p
(
setq
var
(
vl
-
catch
-
all
-
apply
'
vla-addregion
(
list
spc
(
vlax
-
make
-
variant
(
vlax-safearray-fill
(
vlax
-
make
-
safearray
vlax-vbobject
'
(
0
.
0
)
)
(
list
(
vlax
-
ename
->
vla-object
cir
)
)
)
)
)
)
)
)
)
(
not
(
vl-catch-all-error-p
(
setq
rtn
(
vl
-
catch
-
all
-
apply
'
vla-addrevolvedsolid
(
list
spc
(
car
(
setq
reg
(
vlax
-
safearray
->
list
(
vlax
-
variant-value
var
)
)
)
)
(
vlax-3D-point
(
trans
cen ocs
0
)
)
(
vlax-3D-point
ocs
)
an2
)
)
)
)
)
)
(
entdel
ent
)
(
setq
rtn
nil
)
)
(
foreach
obj reg
(
if
(
and
(
=
'
vla-object
(
type
obj
)
)
(
vlax-write-enabled-p
obj
)
)
(
vla-delete
obj
)
)
)
(
if
(
and
(
=
'ename
(
type
cir
)
)
(
not
(
vlax-erased-p
cir
)
)
)
(
entdel
cir
)
)
rtn
)
;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3
(
defun
v
^
v
(
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
)
)
)
)
)
Here's a program to test:
Code - Auto/Visual Lisp:
[Select]
(
defun
c:test
(
/
ent rad
)
(
if
(
and
(
setq
ent
(
car
(
entsel
"
\n
Select arc or circle: "
)
)
)
(
wcmatch
(
cdr
(
assoc
0
(
entget
ent
)
)
)
"ARC,CIRCLE"
)
(
progn
(
initget
6
)
(
setq
rad
(
getdist
"
\n
Specify torus tube radius: "
)
)
)
)
(
LM:arc
->
torus ent rad
)
)
(
princ
)
)
(
vl-load-com
)
(
princ
)
Logged
Lee Mac Programming
•
Twitter
•
Exchange App Store
Jeremy Dunn
Newt
Posts: 31
Re: Arc to torus
«
Reply #3 on:
April 16, 2019, 07:33:48 PM »
Lee to the rescue!
I will study this one closely, I was having trouble figuring what the tangent vector at the start angle was.
Logged
Lee Mac
Seagull
Posts: 12917
London, England
WWW
Re: Arc to torus
«
Reply #4 on:
April 17, 2019, 02:27:45 PM »
You're most welcome Jeremy - feel free to ask questions if you are unsure of anything.
Logged
Lee Mac Programming
•
Twitter
•
Exchange App Store
Print
Pages: [
1
] |
Go Up
« previous
next »
TheSwamp
»
Code Red
»
AutoLISP (Vanilla / Visual)
»
Topic:
Arc to torus