TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Jeremy Dunn on April 14, 2019, 01:08:22 PM

Title: Arc to torus
Post by: Jeremy Dunn 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?
Title: Re: Arc to torus
Post by: kpblc 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.
Title: Re: Arc to torus
Post by: Lee Mac 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. )
Title: Re: Arc to torus
Post by: Jeremy Dunn 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.
Title: Re: Arc to torus
Post by: Lee Mac on April 17, 2019, 02:27:45 PM
You're most welcome Jeremy - feel free to ask questions if you are unsure of anything.  :-)