Author Topic: Arc to torus  (Read 347 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: 297
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: 12195
  • 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
  11.            (< trd rad)
  12.            (progn
  13.                (if (=  "ARC" (cdr (assoc 000 enx)))
  14.                    (setq an1 (cdr (assoc 050 enx))
  15.                        an2 (rem (+ pi pi (- (cdr (assoc 051 enx)) an1)) (+ pi pi))
  16.                    )
  17.                    (setq an1 0.0
  18.                          an2 (+ pi pi)
  19.                    )
  20.                )
  21.                (setq ocs (cdr (assoc 210 enx))
  22.                      cen (cdr (assoc 010 enx))
  23.                      pt1 (trans (polar cen an1 rad) ocs 0)
  24.                      tcs (v^v ocs (mapcar '- pt1 (trans cen ocs 0)))
  25.                      spc (vlax-ename->vla-object (cdr (assoc 330 enx)))
  26.                      cir
  27.                    (entmakex
  28.                        (list
  29.                           '(000 . "CIRCLE")
  30.                            (cons 010 (trans pt1 0 tcs))
  31.                            (cons 040 trd)
  32.                            (cons 210 tcs)
  33.                        )
  34.                    )
  35.                )
  36.            )
  37.            (not
  38.                (vl-catch-all-error-p
  39.                    (setq var
  40.                        (vl-catch-all-apply 'vla-addregion
  41.                            (list spc
  42.                                (vlax-make-variant
  43.                                    (vlax-safearray-fill
  44.                                        (vlax-make-safearray vlax-vbobject '(0 . 0))
  45.                                        (list (vlax-ename->vla-object cir))
  46.                                    )
  47.                                )
  48.                            )
  49.                        )
  50.                    )
  51.                )
  52.            )
  53.            (not
  54.                (vl-catch-all-error-p
  55.                    (setq rtn
  56.                        (vl-catch-all-apply 'vla-addrevolvedsolid
  57.                            (list spc
  58.                                (car
  59.                                    (setq reg
  60.                                        (vlax-safearray->list
  61.                                            (vlax-variant-value var)
  62.                                        )
  63.                                    )
  64.                                )
  65.                                (vlax-3D-point (trans cen ocs 0))
  66.                                (vlax-3D-point ocs)
  67.                                an2
  68.                            )
  69.                        )
  70.                    )
  71.                )
  72.            )
  73.        )
  74.        (entdel ent)
  75.        (setq rtn nil)
  76.    )
  77.    (foreach obj reg
  78.        (if (and (= 'vla-object (type obj)) (vlax-write-enabled-p obj))
  79.            (vla-delete obj)
  80.        )
  81.    )
  82.    (if (and (= 'ename (type cir)) (not (vlax-erased-p cir)))
  83.        (entdel cir)
  84.    )
  85.    rtn
  86. )
  87.  
  88. ;; Vector Cross Product  -  Lee Mac
  89. ;; Args: u,v - vectors in R^3
  90.  
  91. (defun v^v ( u v )
  92.    (list
  93.        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
  94.        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
  95.        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  96.    )
  97. )

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.            (progn
  7.                (initget 6)
  8.                (setq rad (getdist "\nSpecify torus tube radius: "))
  9.            )
  10.        )
  11.        (LM:arc->torus ent rad)
  12.    )
  13.    (princ)
  14. )

Jeremy Dunn

  • Newt
  • Posts: 24
Re: Arc to torus
« Reply #3 on: April 16, 2019, 07:33:48 PM »
Lee to the rescue! :smitten: I will study this one closely, I was having trouble figuring what the tangent vector at the start angle was.

Lee Mac

  • Seagull
  • Posts: 12195
  • 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.  :-)