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]
`;; 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 "\nSelect arc or circle: ")))            (wcmatch  (cdr (assoc 0 (entget ent))) "ARC,CIRCLE")            (progn                (initget 6)                (setq rad (getdist "\nSpecify torus tube radius: "))            )        )        (LM:arc->torus ent rad)    )    (princ))(vl-load-com) (princ)`

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: 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.