Author Topic: POLAR EXTRUDE  (Read 1825 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
POLAR EXTRUDE
« on: January 17, 2014, 07:48:25 AM »
As I wrote in title, does such command exist, or I am missing something in AutoCAD 2014...

I want to quickly make surface entity based on data shown on picture, I think that here even guidlines are sufficient...

M.R.

If nothing, maybe A2015 then...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1734
  • BricsCAD 18
Re: POLAR EXTRUDE
« Reply #1 on: January 17, 2014, 10:01:01 AM »
I don't know if there is a command or option to accomplish this. But writing a program would not be very hard I think.

Didge

  • Bull Frog
  • Posts: 211
Re: POLAR EXTRUDE
« Reply #2 on: January 17, 2014, 10:05:29 AM »
Try the "Edgesurf" command, it will however require 4 defining edges, so your white 2D/3D polyline may need to be broken around it's midpoint.
Think Slow......

GP

  • Newt
  • Posts: 82
  • Vercelli, Italy
Re: POLAR EXTRUDE
« Reply #3 on: January 17, 2014, 11:24:37 AM »
Try this, Marko.

Code: [Select]
(defun c:test ( / var val PL v LL)
    (setq var '(cmdecho loftnormals loftparam) ;LM
          val  (mapcar 'getvar var)            ;LM
    )
    (mapcar 'setvar var '(0 0 7)) ; <- JB
    (if (and
            (setq PL (car (entsel "\nSelect Polyline")))
            (setq v (getpoint "\nSelect apex"))
        )
        (progn
            (foreach x (pl_coord PL)
                (setq LL (cons (entmakex (list '(0 . "LINE") (cons 10 x) (cons 11 v))) LL))
            )
            (command "_loft")
            (apply 'command LL)
            (command "" "")           
            (foreach x LL
                (if (not (vlax-erased-p x)) (entdel x))
            )
        )
    )   
    (mapcar 'setvar var val)
    (princ)
)

(defun pl_coord (# / p m)
    (setq p (if (vlax-curve-IsClosed #)
                (fix (vlax-curve-getEndParam #))
                (1+ (fix (vlax-curve-getEndParam #)))
            )
    )
    (while (/= 0 p)
        (setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
    )
)
« Last Edit: January 17, 2014, 11:30:17 AM by GP »

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
Re: POLAR EXTRUDE
« Reply #4 on: January 17, 2014, 01:44:03 PM »
Thanks for replys... However, my example isn't quite what should be... I thought 2d/3d pline curve entity - so only real new POLAR EXTRUDE command could be what is needed... I've posted this topic into Wish list for newer release... As there are many 3d commands that are built-in A2014 that are even more complex than this, I thought this will fulfill CAD arsenal... Lofting is nearest to what I was looking for, or suggested edgesurf command, but I really think this is what is missing - I often have this kind of situation (3 edges + apex point) and I solved this before with 0-line as 4th edge... But is this 0-line necessity?
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
Re: POLAR EXTRUDE
« Reply #5 on: January 17, 2014, 02:06:11 PM »
Thanks for replys... However, my example isn't quite what should be... I thought 2d/3d pline curve entity - so only real new POLAR EXTRUDE command could be what is needed... I've posted this topic into Wish list for newer release... As there are many 3d commands that are built-in A2014 that are even more complex than this, I thought this will fulfill CAD arsenal... Lofting is nearest to what I was looking for, or suggested edgesurf command, but I really think this is what is missing - I often have this kind of situation (3 edges + apex point) and I solved this before with 0-line as 4th edge... But is this 0-line necessity?

Try this, Marko.

Code: [Select]
(defun c:test ( / var val PL v LL)
    (setq var '(cmdecho loftnormals loftparam) ;LM
          val  (mapcar 'getvar var)            ;LM
    )
    (mapcar 'setvar var '(0 0 7)) ; <- JB
    (if (and
            (setq PL (car (entsel "\nSelect Polyline")))
            (setq v (getpoint "\nSelect apex"))
        )
        (progn
            (foreach x (pl_coord PL)
                (setq LL (cons (entmakex (list '(0 . "LINE") (cons 10 x) (cons 11 v))) LL))
            )
            (command "_loft")
            (apply 'command LL)
            (command "" "")           
            (foreach x LL
                (if (not (vlax-erased-p x)) (entdel x))
            )
        )
    )   
    (mapcar 'setvar var val)
    (princ)
)

(defun pl_coord (# / p m)
    (setq p (if (vlax-curve-IsClosed #)
                (fix (vlax-curve-getEndParam #))
                (1+ (fix (vlax-curve-getEndParam #)))
            )
    )
    (while (/= 0 p)
        (setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
    )
)

As a matter a fact, your code GP is just what I was looking for...

Thank you Gian, it works like a charm and on curves...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

GP

  • Newt
  • Posts: 82
  • Vercelli, Italy
Re: POLAR EXTRUDE
« Reply #6 on: January 18, 2014, 01:25:06 PM »
You're welcome, Marko.
Already works in this way with closed polylines.

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
Re: POLAR EXTRUDE
« Reply #7 on: January 21, 2014, 11:25:40 AM »
Thanks for the tip, GP...
Look now - it works and for open 2d / 3d curves (spline)...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
Re: POLAR EXTRUDE
« Reply #8 on: December 03, 2019, 06:02:59 AM »
I've just updated my routine for polar extrude... I thought I would share it for you... Maybe you'll find some lacks I missed...
Thanks, M.R.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:polarextrude ( / makeplane c p co p1 p2 nc plane el pl cl pp 3p ell s )
  2.  
  3.  
  4.   (defun makeplane ( p1 p2 p3 / unit v^v n ci )
  5.  
  6.     (defun unit ( v / d )
  7.       (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  8.         (mapcar '(lambda ( x ) (/ x d)) v)
  9.       )
  10.     )
  11.  
  12.     (defun v^v ( u v )
  13.       (list
  14.         (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
  15.         (- (* (caddr u) (car v)) (* (car u) (caddr v)))
  16.         (- (* (car u) (cadr v)) (* (cadr u) (car v)))
  17.       )
  18.     )
  19.  
  20.     (setq n (unit (v^v (mapcar '- p2 p1) (mapcar '- p2 p3))))
  21.     (setq ci (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 10 (trans p2 0 n)) (cons 40 1e+6) (cons 210 n))))
  22.     (vl-cmdf "_.REGION" ci "")
  23.     (vl-cmdf "_.CONVTOSURFACE" "_L" "")
  24.     (entlast)
  25.   )
  26.  
  27.   (while
  28.     (or
  29.       (not (setq c (car (entsel "\nPick curve entity..."))))
  30.       (if c
  31.         (or
  32.           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendpoint (list c)))
  33.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget c))))))))
  34.         )
  35.       )
  36.     )
  37.     (prompt "\nMissed or picked entity not curve or picked curve on locked layer...")
  38.     (textscr)
  39.   )
  40.   (initget 1)
  41.   (setq p (getpoint "\nPick or specify apex point : "))
  42.   (initget 1 "G0 G1")
  43.   (setq co (getkword "\nSpecify continuity (G0 - vertex position; G1 - tangent surface at vertex) [G0/G1] : "))
  44.     (vl-cmdf "_.LOFT" c "_PO" "_non" p "_MO" "SU" "_CO" co "")
  45.     (progn
  46.       (setq p1 (vlax-curve-getstartpoint c))
  47.       (setq p2 (vlax-curve-getendpoint c))
  48.       (setq nc (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object c))))
  49.       (setq plane (makeplane p1 (trans p 1 0) p2))
  50.       (vl-cmdf "_.IMPRINT" plane nc "_N")
  51.       (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  52.       (setq el (entlast))
  53.       (vl-cmdf "_.SELECT" plane "")
  54.       (while (and (ssget "_P") (not (vl-some '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "CIRCLE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))))
  55.         (initcommandversion)
  56.         (vl-cmdf "_.EXPLODE" "_P")
  57.         (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
  58.       )
  59.       (while (setq el (entnext el))
  60.         (if (= (cdr (assoc 0 (entget el))) "POINT")
  61.           (setq pl (cons (trans (cdr (assoc 10 (entget el))) 0 1) pl))
  62.         )
  63.         (entdel el)
  64.       )
  65.       (entdel c)
  66.       (setq el (entlast))
  67.       (setq cl (cons nc cl))
  68.       (foreach pp pl
  69.         (vl-cmdf "_.BREAK" "_non" pp "_non" pp)
  70.       )
  71.       (while (setq el (entnext el))
  72.         (setq cl (cons el cl))
  73.       )
  74.       (foreach cc cl
  75.         (setq p1 (trans (vlax-curve-getstartpoint cc) 0 1))
  76.         (setq p2 (trans (vlax-curve-getendpoint cc) 0 1))
  77.         (setq pp (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  78.         (vl-cmdf "_.3DPOLY" "_non" p1 "_non" pp "_non" p2 "")
  79.         (setq 3p (entlast))
  80.         (initcommandversion)
  81.         (vl-cmdf "_.JOIN" 3p cc "")
  82.         (if (and cc (not (vlax-erased-p cc)))
  83.           (setq el cc)
  84.           (if (and 3p (not (vlax-erased-p 3p)))
  85.             (setq el 3p)
  86.             (setq el (entlast))
  87.           )
  88.         )
  89.         (setq ell (entlast))
  90.         (vl-cmdf "_.LOFT" el "_PO" "_non" p "_MO" "SU" "_CO" co "")
  91.         (if (not (eq ell (entlast)))
  92.           (vl-cmdf "_.EXPLODE" "_L")
  93.         )
  94.         (if (setq s (ssget "_C" pp pp))
  95.           (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  96.             (entdel e)
  97.           )
  98.         )
  99.         (if (and el (not (vlax-erased-p el)))
  100.           (entdel el)
  101.         )
  102.       )
  103.       (entdel c)
  104.     )
  105.   )
  106.   (princ)
  107. )
  108.  

Regards...
« Last Edit: December 03, 2019, 08:02:01 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2187
  • Marko Ribar, architect
Re: POLAR EXTRUDE
« Reply #9 on: December 03, 2019, 11:34:27 AM »
Never really planned to code it this simple, but it's error free and it does the job relatively exact if you don't count zooming too much...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:polarextrude-new ( / c p co nc )
  2.  
  3.  
  4.   (while
  5.     (or
  6.       (not (setq c (car (entsel "\nPick curve entity..."))))
  7.       (if c
  8.         (or
  9.           (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendpoint (list c)))
  10.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget c))))))))
  11.         )
  12.       )
  13.     )
  14.     (prompt "\nMissed or picked entity not curve or picked curve on locked layer...")
  15.     (textscr)
  16.   )
  17.   (initget 1)
  18.   (setq p (getpoint "\nPick or specify apex point : "))
  19.     (progn
  20.       (initget 1 "G0 G1")
  21.       (setq co (getkword "\nSpecify continuity (G0 - vertex position; G1 - tangent surface at vertex) [G0/G1] : "))
  22.       (vl-cmdf "_.LOFT" c "_PO" "_non" p "_MO" "SU" "_CO" co "")
  23.     )
  24.     (progn
  25.       (setq nc (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object c))))
  26.       (vl-cmdf "_.SCALE" nc "" "_non" p 1e-3)
  27.       (vl-cmdf "_.LOFT" c nc "" "_MO" "_SU" "")
  28.     )
  29.   )
  30.   (princ)
  31. )
  32.  

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube