Here is a great routine that lets you easily fillet a 3D polyline. It even gives the option to apply the fillet to all of the vertices.
Here’s how:
- 3DPOLYFILLET <enter> to start
- R <enter> to specify the radius of the fillet
- Specify the radius <enter>
- Select the segments for the fillet
- Or
- Select the first segment and then enter A <enter> to apply the fillet to all segments.
;;; 3dPolyFillet -Gilles Chanteau- 21/01/07 -Version 1.5- ;;; "Fillets" a 3D polyline (succession of segments) (defun c:3dPolyFillet (/ 3dPolyFillet_err closest_vertices MakeFillet AcDoc ModSp cnt prec rad ent1 ent2 vxlst plst param obj ) (vl-load-com) ;;;*************************************************************;;; (defun 3dPolyFillet_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;;*************************************************************;;; (defun closest_vertices (obj pt / par) (if (setq par (vlax-curve-getParamAtPoint obj pt)) (list (vlax-curve-getPointAtParam obj (fix par)) (vlax-curve-getPointAtParam obj (1+ (fix par))) ) ) ) ;;;*************************************************************;;; (defun MakeFillet (obj par1 par2 / pts1 pts2 som p1 p2 ptlst norm pt0 pt1 pt2 pt3 pt4 cen ang inc n vlst nb1 nb2 ) (if (and (setq pts1 (closest_vertices obj par1)) (setq pts2 (closest_vertices obj par2)) ) (progn (setq som (inters (car pts1) (cadr pts1) (car pts2) (cadr pts2) nil)) (if som (if (or (equal (car pts1) som 1e-9) (equal (cadr pts1) som 1e-9) (and (< (vlax-curve-getParamAtPoint obj (car pts1)) (vlax-curve-getParamAtPoint obj (car pts2)) ) (equal (vec1 (car pts1) (cadr pts1)) (vec1 (car pts1) som) 1e-9 ) ) (and (< (vlax-curve-getParamAtPoint obj (car pts2)) (vlax-curve-getParamAtPoint obj (car pts1)) ) (equal (vec1 (cadr pts1) (car pts1)) (vec1 (cadr pts1) som) 1e-9 ) ) ) (progn (if (< (distance som (car pts1)) (distance som (cadr pts1))) (setq p1 (cadr pts1) p2 (car pts2) ) (setq p1 (car pts1) p2 (cadr pts2) ) ) (if (= rad 0) (setq ptlst (list som)) (progn (setq norm (norm_3pts som p2 p1) pt0 (trans som 0 norm) pt1 (trans p1 0 norm) pt2 (trans p2 0 norm) cen (inters (polar pt0 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt1 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt0 (+ (angle pt0 pt2) (/ pi 2)) rad) (polar pt2 (+ (angle pt0 pt2) (/ pi 2)) rad) nil ) pt3 (polar cen (- (angle pt1 pt0) (/ pi 2)) rad) pt4 (polar cen (+ (angle pt2 pt0) (/ pi 2)) rad) ang (- (angle cen pt4) (angle cen pt3)) ) (if (and (inters pt0 pt1 cen pt3 T) (inters pt0 pt2 cen pt4 T)) (progn (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) (setq inc (/ ang prec) n 0 ) (repeat (1+ prec) (setq ptlst (cons (polar cen (- (angle cen pt4) (* inc n)) rad) ptlst ) n (1+ n) ) ) (setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst)) ) ) ) ) (setq vlst (3d-coord->pt-lst (vlax-get obj 'Coordinates))) (if ptlst (progn (setq nb1 (vl-position p1 vlst) nb2 (vl-position p2 vlst) ) (if (= (vla-get-closed obj) :vlax-true) (cond ((and (equal p1 (car vlst)) (equal p2 (cadr (reverse vlst))) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst)) ) ) ((and (equal p1 (cadr (reverse vlst))) (equal p2 (car vlst)) ) (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst)) ) ((and (equal p1 (cadr vlst)) (equal p2 (last vlst)) ) (setq vlst (append (reverse ptlst) (sublst vlst (1+ nb1) nil)) ) ) ((and (equal p1 (last vlst)) (equal p2 (cadr vlst)) ) (setq vlst (append ptlst (sublst vlst (1+ nb2) nil)) ) ) (T (if (< nb1 nb2) (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst (sublst vlst (1+ nb2) nil) ) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst) (sublst vlst (1+ nb1) nil) ) ) ) ) ) (if (equal (car vlst) (last vlst) 1e-9) (cond ((and (equal p1 (cadr vlst)) (equal p2 (cadr (reverse vlst))) ) (setq vlst (append (sublst vlst 2 nb2) (reverse ptlst) (list (cadr vlst)) ) ) ) ((and (equal p1 (cadr (reverse vlst))) (equal p2 (cadr vlst)) ) (setq vlst (append (sublst vlst 2 nb1) ptlst (list (cadr vlst)) ) ) ) ) (if (< nb1 nb2) (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst (sublst vlst (1+ nb2) nil) ) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst) (sublst vlst (1+ nb1) nil) ) ) ) ) ) (vlax-put obj 'Coordinates (apply 'append vlst)) ) (prompt "\nRadius is too large.") ) ) (prompt "\nDivergent segments.") ) (prompt "\nSegments are not converging.") ) ) (prompt "\nRadius is too large.") ) ) ;;;*************************************************************;;; (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) ModSp (vla-get-ModelSpace AcDoc) ) (setq m:err *error* *error* 3dPolyFillet_err ) (vla-StartUndoMark AcDoc) ;; Saisie des données (if (not (vlax-ldata-get "3dFillet" "Prec")) (vlax-ldata-put "3dFillet" "Prec" 20) ) (if (not (vlax-ldata-get "3dFillet" "Rad")) (vlax-ldata-put "3dFillet" "Rad" 10.0) ) (prompt (strcat "\nCurrent settings.\tSegments: " (itoa (vlax-ldata-get "3dFillet" "Prec")) "\tRadius: " (rtos (vlax-ldata-get "3dFillet" "Rad")) ) ) (setq cnt 1) (while (= 1 cnt) (initget 1 "Segments Radius") (setq ent1 (entsel "\nSelect first segment ou [Segments/Radius]: " ) ) (cond ((not ent1) (prompt "\nNone selected object.") ) ((= ent1 "Segments") (initget 6) (if (setq prec (getint (strcat "\nSpecify le number of segments for arcs <" (itoa (vlax-ldata-get "3dFillet" "Prec")) ">: " ) ) ) (vlax-ldata-put "3dFillet" "Prec" prec) ) ) ((= ent1 "Radius") (initget 4) (if (setq rad (getdist (strcat "\nSpecify the radius <" (rtos (vlax-ldata-get "3dFillet" "Rad")) ">: " ) ) ) (vlax-ldata-put "3dFillet" "Rad" rad) ) ) ((and (= (cdr (assoc 0 (entget (car ent1)))) "POLYLINE") (= (logand 8 (cdr (assoc 70 (entget (car ent1))))) 8) ) (setq cnt 0) ) (T (prompt "\nSelected object is not a 3D polyline.") ) ) ) (setq prec (vlax-ldata-get "3dFillet" "Prec") rad (vlax-ldata-get "3dFillet" "Rad") ) (while (not ent2) (initget 1 "All") (setq ent2 (entsel "\nSelect second segment or [All]: ")) (if (not (or (= ent2 "All") (eq (car ent1) (car ent2)))) (progn (prompt "\nThe selected segment is not on same object" ) (setq ent2 nil) ) ) ) (setq obj (vlax-ename->vla-object (car ent1))) (if (= ent2 "All") (progn (setq vxlst (3d-coord->pt-lst (vlax-get obj 'Coordinates)) param 0.5 ) (repeat (if (= (vla-get-closed obj) :vlax-true) (length vxlst) (1- (length vxlst))) (setq plst (append plst (list (vlax-curve-getPointAtParam obj param))) param (1+ param) ) ) (if (or (= (vla-get-closed obj) :vlax-true) (equal (car vxlst) (last vxlst) 1e-9) ) (setq plst (cons (last plst) plst)) ) (setq cnt 0) (repeat (1- (length plst)) (MakeFillet obj (nth cnt plst) (nth (setq cnt (1+ cnt)) plst)) ) ) (MakeFillet obj (trans (osnap (cadr ent1) "_nea") 1 0) (trans (osnap (cadr ent2) "_nea") 1 0) ) ) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;;*************************************************************;;; ;;;*********************** SOUS ROUTINES ***********************;;; ;;; NORM_3PTS returns the normal vector of a 3 points defined plane (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (if (inters org xdir org ydir) (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm))) (setq norm (list (- (* (cadr xdir) (caddr ydir)) (* (caddr xdir) (cadr ydir)) ) (- (* (caddr xdir) (car ydir)) (* (car xdir) (caddr ydir)) ) (- (* (car xdir) (cadr ydir)) (* (cadr xdir) (car ydir)) ) ) ) ) ) ) ;;;*************************************************************;;; ;;; 3d-coord->pt-lst Convert a 3D coordinates flat list in points list ;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0)) (defun 3d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst)) ) ) ) ;;;*************************************************************;;; ;;; SUBLST Returns a sub list ;;; First item : 1 ;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4) ;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6) (defun sublst (lst start leng / rslt) (if (not (<= 1 leng (- (length lst) start))) (setq leng (- (length lst) (1- start))) ) (repeat leng (setq rslt (cons (nth (1- start) lst) rslt) start (1+ start) ) ) (reverse rslt) ) ;;;*************************************************************;;; ;;; VEC1 Returns the singleunit vector from p1 to p2 (defun vec1 (p1 p2) (if (not (equal p1 p2 1e-009)) (mapcar '(lambda (x1 x2) (/ (- x2 x1) (distance p1 p2)) ) p1 p2 ) ) ) ;;;*************************************************************;;; ;;; BUTLAST List but last item (defun butlast (lst) (reverse (cdr (reverse lst))) )
I would like to use this code in my work. I tried running this in autocad 2002. The lisp would not load. syntax error. Maybe it won’t work with this older version of autocad?
In my visual lisp editor I tried to check the code and got this message:
[CHECKING TEXT 3dPolyFillet.lsp loading…]
.
; warning: too few arguments: (TRANS SOM NORM)
; warning: too few arguments: (TRANS P1 NORM)
; warning: too few arguments: (TRANS P2 NORM)
; error: too few arguments in SETQ: (SETQ INC (/ ANG PREC)
…..
; Check done.
Since your are more familiar with your own code, can you help?
I would actually suggest that the question be directed to the author Gilles Chanteau. The link to where this routine was found is http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/3D-Tube-Along-A-Path-Please-Help/td-p/.UM8UOuSLlyI.
Gilles is pretty good about responding to questions…
~Greg
Well done…very good, that routine very help me in road design.
Thanks
AWESOME lisp, VERY useful….
No need to change ucs each time…
With this one we can create smooth 3d paths and
extrude over them various shapes…
thx :) :) :)