TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: dussla 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 ~
-
You can extrude to a path, not sure if you know this.
-
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.
;; 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).
-
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.
(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).
-
You're welcome.
I edit my post, the code posted was not the last version, sorry.
-
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.
-
A little animation
-
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 ~
-
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.