Author Topic: custom polyline extrude ~  (Read 4591 times)

0 Members and 1 Guest are viewing this topic.

dussla

  • Bull Frog
  • Posts: 286
custom polyline extrude ~
« on: January 10, 2008, 11:45:47 PM »
hi friends
sorry to asking you of the same things again and again
but you know , i can't escape from my curiousity , you know ?

when i  use  extrude command ,  there is some complex ( ex : rotate profile in 3d ucs )
so i found good lisp routine for easy path extrude .
if you see routine  attacthed lisp ,  that routine make  pipe  from polyline.
other extrude routine is many error. but  this is perpect routine  for 3d polyline extrude .
that routine  make  circle tube  only , but i need  need routine below .

i need custom polyline extrude
   1.  i draw   custome shape ( ex:  rectangle , rotated rectangle , star ,triangle ,custom     shape ........ :-P

  2. i select base point   from  custom shape   for  extrude  vector nomal base

  3. excute ~

can you help me again ~~
really sorry  , many question always ~




« Last Edit: January 11, 2008, 10:50:45 AM by dussla »

deegeecees

  • Guest
Re: custom polyline extrude ~
« Reply #1 on: January 11, 2008, 01:48:52 PM »
You can extrude to a path, not sure if you know this.

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: custom polyline extrude ~
« Reply #2 on: January 13, 2008, 08:33:49 AM »
Hi,

I tried to write something, it's quite more difficult to deal with shapes wich aren't circles.

The user selects the profile to be extruded and a base point, then select pathes.

The normal vector of the profile is aligned to the start tangent vector of each path.

Code: [Select]
;; MEXTRUDE -Gilles Chanteau- (gile) 2008-01-13
;; Extrudes the profile along selected pathes.
;; The profile normal vector is aligned to the start tangent vector of each path

(defun c:mextrude (/ space prof org ss start reg mat norm)

  (vl-load-com)

  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
      )
  )
  (if (and (setq prof (car (entsel "\nSelect the profile: ")))
   (setq prof (vlax-ename->vla-object prof))
   (or
     (= (vla-get-ObjectName prof) "AcDbRegion")
     (and
       (not (vl-catch-all-error-p
      (setq prof
     (vl-catch-all-apply
       'vlax-invoke
       (list space 'addRegion (list prof))
     )
      )
    )
       )
       (setq prof (car prof))
     )
   )
      )
    (if
      (setq org (trans (getpoint "\nBase point: ") 1 0))
       (if
(setq ss (ssget
    '((-4 . "<OR")
      (0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE")
      (-4 . "<AND")
      (0 . "POLYLINE")
      (-4 . "<NOT")
      (-4 . "&")
      (70 . 112)
      (-4 . "NOT>")
      (-4 . "AND>")
      (-4 . "<AND")
      (0 . "SPLINE")
      (-4 . "&")
      (70 . 8)
      (-4 . "AND>")
      (-4 . "OR>")
     )
  )
)
  (progn
    (vla-StartUndoMark *acdoc*)
    (vlax-for obj (vla-get-ActiveSelectionSet *acdoc*)
      (setq start (vlax-curve-getPointAtParam
    obj
    (vlax-curve-getStartParam obj)
  )
    norm  (vunit
    (vlax-curve-getFirstDeriv
      obj
      (vlax-curve-getStartParam obj)
    )
  )
      )
      (setq reg (vla-copy prof))
      (setq mat
     (mxm
       (mapcar
(function
   (lambda (x)
     (trans x 0 norm T)
   )
)
(list '(1 0 0) '(0 1 0) '(0 0 1))
       )
       (mapcar
(function
   (lambda (x)
     (trans x (vlax-get reg 'Normal) 0 T)
   )
)
(list '(1 0 0) '(0 1 0) '(0 0 1))
       )
     )
      )
      (vla-TransformBy
reg
(vlax-tmatrix
  (append
    (mapcar
      (function
(lambda (v o)
  (append v (list o))
)
      )
      mat
      (mapcar '- start (mxv mat org))
    )
    (list '(0 0 0 1))
  )
)
      )
      (vla-addExtrudedSolidAlongPath Space reg obj)
      (vla-delete reg)
    )
    (vla-EndUndoMark *acdoc*)
  )
       )
    )
    (princ "\nUnvalid profile.")
  )
  (princ)
)

; Sub routines

;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)

;;; VLEN Returns the length of a vector
(defun vlen (v)
  (sqrt (vxv v v))
)

;;; VUNIT Returns the single unit vector of a vector
(defun vunit (v / l)
  (if (/= 0 (setq l (vlen v)))
    (mapcar '(lambda (x) (/ x l)) v)
  )
)

;; transpose a matrix (Doug Wilson)
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector (Vladimir Nesterovsky)
(defun mxv (m v)
  (mapcar '(lambda (r) (vxv r v)) m)
)

;; Multiply two matrices (Vladimir Nesterovsky)
(defun mxm (m q)
  (mapcar '(lambda (r) (mxv (trp q) r)) m)
)

PS: if you want to make pipes (rather than cylinders), you can use Curve2Pipe (attached file).
« Last Edit: January 13, 2008, 09:27:21 AM by gile »
Speaking English as a French Frog

dussla

  • Bull Frog
  • Posts: 286
Re: custom polyline extrude ~
« Reply #3 on: January 13, 2008, 09:13:30 AM »
perpect ~~~ really perpect
gile   always thank you for your kind help ~

ps :  thank you again







Hi,

I tried to write something, it's quite more difficult to deal with shapes wich aren't circles.

The user selects the profile to be extruded and a base point, then select pathes.

The normal vector of the profile is aligned to the start tangent vector of each path.

Code: [Select]
(defun c:mextrude (/ space prof org ss obj start reg mat norm)

  (vl-load-com)

  (or *acdoc*
      (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq space (if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace *acdoc*)
(vla-get-ModelSpace *acdoc*)
      )
  )
  (if (and (setq prof (car (entsel "\nSelect the profile (region): ")))
   (setq prof (vlax-ename->vla-object prof))
   (= (vla-get-ObjectName prof) "AcDbRegion")
      )
    (if (setq org (trans (getpoint "\nOrigin: ") 1 0))
      (if (setq ss (ssget
     '((-4 . "<OR")
       (0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE")
       (-4 . "<AND")
       (0 . "POLYLINE")
       (-4 . "<NOT")
       (-4 . "&")
       (70 . 112)
       (-4 . "NOT>")
       (-4 . "AND>")
       (-4 . "<AND")
       (0 . "SPLINE")
       (-4 . "&")
       (70 . 8)
       (-4 . "AND>")
       (-4 . "OR>")
      )
   )
  )
(progn
  (vla-StartUndoMark *acdoc*)
  (vlax-for obj (vla-get-ActiveSelectionSet *acdoc*)
    (setq start (vlax-curve-getPointAtParam
  obj
  (vlax-curve-getStartParam obj)
)
  norm (vunit
  (vlax-curve-getFirstDeriv
    obj
    (vlax-curve-getStartParam obj)
  )
)
    )
    (setq reg (vla-copy prof))
    (setq mat
   (mxm
     (mapcar
       (function
(lambda (x)
   (trans x 0 norm T)
)
       )
       (list '(1 0 0) '(0 1 0) '(0 0 1))
     )
     (mapcar
       (function
(lambda (x)
   (trans x (vlax-get reg 'Normal) 0 T)
)
       )
       (list '(1 0 0) '(0 1 0) '(0 0 1))
     )
   )
    )
    (vla-TransformBy
      reg
      (vlax-tmatrix
(append
  (mapcar
    (function
      (lambda (v o)
(append v (list o))
      )
    )
    mat
    (mapcar '- start (mxv mat org))
  )
  (list '(0 0 0 1))
)
      )
    )
    (vla-addExtrudedSolidAlongPath space reg obj)
    (if (< 0 (getvar "DELOBJ"))
      (mapcar 'vla-delete (list reg obj))
    )
  )
  (vla-EndUndoMark *acdoc*)
)
      )
    )
    (princ "\nThe profile have to be a Region.")
  )
  (princ)
)

; Sub routines

;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)

;;; VLEN Returns the length of a vector
(defun vlen (v)
  (sqrt (vxv v v))
)

;;; VUNIT Returns the single unit vector of a vector
(defun vunit (v / l)
  (if (/= 0 (setq l (vlen v)))
    (mapcar '(lambda (x) (/ x l)) v)
  )
)

;; transpose a matrix (Doug Wilson)
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector (Vladimir Nesterovsky)
(defun mxv (m v)
  (mapcar '(lambda (r) (vxv r v)) m)
)

;; Multiply two matrices (Vladimir Nesterovsky)
(defun mxm (m q)
  (mapcar '(lambda (r) (mxv (trp q) r)) m)
)

PS: if you want to make pipes (rather than cylinders), you can use Curve2Pipe (attached file).


gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: custom polyline extrude ~
« Reply #4 on: January 13, 2008, 09:30:13 AM »
You're welcome.

I edit my post, the code posted was not the last version, sorry.
Speaking English as a French Frog

dussla

  • Bull Frog
  • Posts: 286
Re: custom polyline extrude ~
« Reply #5 on: January 13, 2008, 09:33:49 PM »
again  more perpect ~
 :lol: :lol: :lol: :lol: :lol: :lol: :lol:


You're welcome.

I edit my post, the code posted was not the last version, sorry.

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: custom polyline extrude ~
« Reply #6 on: January 14, 2008, 03:50:47 PM »
A little animation
Speaking English as a French Frog

dussla

  • Bull Frog
  • Posts: 286
Re: custom polyline extrude ~
« Reply #7 on: January 14, 2008, 07:13:32 PM »
sorry ~~~
i thought  your function don't have mutiple path fucnction ~~
i tried again
mutilple path  is perpect
at any way  really really  thank you 
oh my god ~ you are perpect man ~

Elvis Mirabet Lemos

  • Mosquito
  • Posts: 2
Extrusion de una region a través de un camino
« Reply #8 on: July 01, 2020, 01:38:58 AM »
Buenos dias
Trabajo wn VBA para autocad, cuando utilizo el código siguiente, autocad da error
Set SolidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(RegionObj(0),SplineObj)
Para comprobar que no hay problemas con la region o con el spline, voy a la consola de ejecucion de codigos de autocad, ejecuto comando extruded, indico la region, doy enter, escribo T, para indicar la trayectoria, indico la spline y se hace el sólido, no entiendo como por fuera el sistema lo hace y mediante programacion no, autodesk pone algun problema con esto pero soy cubano y no puedo acceder, favor alguien puede ayudarme, gracias.