### Author Topic: Arc to torus  (Read 810 times)

0 Members and 1 Guest are viewing this topic.

#### Jeremy Dunn

• Newt
• Posts: 24
##### 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?

#### kpblc

• Bull Frog
• Posts: 338
##### 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.
Sorry for my English.

#### Lee Mac

• Seagull
• Posts: 12330
• London, England
##### 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]
1. ;; Arc -> Torus  -  Lee Mac
2. ;; ent - Arc or Circle entity
3. ;; trd - Torus tube radius
4.
5. (defun LM:arc->torus ( ent trd / an1 an2 cen cir enx ocs pt1 rad reg rtn spc tcs var )
6.     (setq enx (entget ent)
7.           rad (cdr (assoc 040 enx))
8.     )
9.     (if
10.         (and
12.                 (if (=  "ARC" (cdr (assoc 000 enx)))
13.                     (setq an1 (cdr (assoc 050 enx))
14.                           an2 (rem (+ pi pi (- (cdr (assoc 051 enx)) an1)) (+ pi pi))
15.                     )
16.                     (setq an1 0.0
17.                           an2 (+ pi pi)
18.                     )
19.                 )
20.                 (setq ocs (cdr (assoc 210 enx))
21.                       cen (cdr (assoc 010 enx))
22.                       pt1 (trans (polar cen an1 rad) ocs 0)
23.                       tcs (v^v ocs (mapcar '- pt1 (trans cen ocs 0)))
24.                       spc (vlax-ename->vla-object (cdr (assoc 330 enx)))
25.                       cir
26.                         (list
27.                            '(000 . "CIRCLE")
28.                             (cons 010 (trans pt1 0 tcs))
29.                             (cons 040 trd)
30.                             (cons 210 tcs)
31.                         )
32.                     )
33.                 )
34.             )
35.             (not
36.                     (setq var
38.                             (list spc
39.                                 (vlax-make-variant
40.                                         (vlax-make-safearray vlax-vbobject '(0 . 0))
41.                                         (list (vlax-ename->vla-object cir))
42.                                     )
43.                                 )
44.                             )
45.                         )
46.                     )
47.                 )
48.             )
49.             (not
50.                     (setq rtn
52.                             (list spc
53.                                 (car
54.                                     (setq reg
55.                                         (vlax-safearray->list
56.                                             (vlax-variant-value var)
57.                                         )
58.                                     )
59.                                 )
60.                                 (vlax-3D-point (trans cen ocs 0))
61.                                 (vlax-3D-point ocs)
62.                                 an2
63.                             )
64.                         )
65.                     )
66.                 )
67.             )
68.         )
69.         (entdel ent)
70.         (setq rtn nil)
71.     )
72.     (foreach obj reg
73.         (if (and (= 'vla-object (type obj)) (vlax-write-enabled-p obj))
74.             (vla-delete obj)
75.         )
76.     )
77.     (if (and (= 'ename (type cir)) (not (vlax-erased-p cir)))
78.         (entdel cir)
79.     )
80.     rtn
81. )
82.
83. ;; Vector Cross Product  -  Lee Mac
84. ;; Args: u,v - vectors in R^3
85.
86. (defun v^v ( u v )
87.     (list
89.         (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
90.         (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
91.     )
92. )

Here's a program to test:
Code - Auto/Visual Lisp: [Select]
1. (defun c:test ( / ent rad )
2.     (if
3.         (and
4.             (setq ent (car (entsel "\nSelect arc or circle: ")))
5.             (wcmatch  (cdr (assoc 0 (entget ent))) "ARC,CIRCLE")
6.                 (initget 6)
8.             )
9.         )
11.     )
12.     (princ)
13. )

#### Jeremy Dunn

• Newt
• Posts: 24
##### 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.

#### Lee Mac

• Seagull
• Posts: 12330
• London, England
##### 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.