;;;                                                                ;;;
;;;  file:   HelixAlongPath.LSP                                    ;;;
;;;                                                                ;;;
;;;  note:   Creating a Helix (spline) along a path                ;;;
;;;          Version 1.0 - 03/10/2014                              ;;;
;;;                                                                ;;;
;;;  author: Gian Paolo Cattaneo                                   ;;;
;;;                                                                ;;;

(defun c:helix2 ( / path step pitch L_path List_p n n2 d d1 radius p1 p2 p2a p3 p4 ang T_start T_end fd )

    (setq olderr  *error*  *error* myerror)
    (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    (or method (setq method "H"))
    (if (and
            (while (not path)
                (setvar "errno" 0)
                (setq path (car (entsel "\nSelect path ")))
                (if (= 7 (getvar 'errno)) (princ "\nNo objects selected"))
                (if (= 'ename (type path))
                    (if (null (wcmatch (cdr (assoc 0 (entget path))) "LINE,POLYLINE,LWPOLYLINE,CIRCLE,ARC,SPLINE,ELLIPSE,HELIX"))
                        (progn
                            (princ "\nInvalid object")
                            (setq path nil)
                        )
                        (progn (redraw path 3) t)
                    )
                )
            )
            (not
                (while
                    (progn
                        (initget (+ 4 2))
                        (setq diam
                            (cond
                                ( (getdist (strcat "\nSpecify the diameter of helix " (if diam (strcat " <" (rtos diam) ">: ")": "))) )
                                ( diam )
                            )
                        )
                        (if (null diam) t) 
                    )
                )
            )
            (H_or_N)
        )
        (progn
            (redraw path 4)
            (setq L_path (vlax-curve-getDistAtParam path (vlax-curve-getEndParam path)))
            (if (equal method "H")
                (setq pitch (/ (/ L_path (fix (/ L_path turn_H))) 4.0))
                (setq pitch (/ (/ L_path turn_N) 4.0))
            )
            (setq step (- pitch))
            (setq n 0)
            (setq n2 0)
            (setq radius (/ diam 2.0))
            (repeat (setq n1 (1+ (fix (/ L_path pitch))))
                (setq n2 (1+ n2))
                (setq p1 (vlax-curve-getpointatdist path (setq step (+ step pitch))))
                (setq p2 (vlax-curve-getpointatdist path (+ step (/ pitch 100.0))))
                (if (= n1 n2)
                    (setq p1 (vlax-curve-getpointatdist path L_path)
                          p2 (vlax-curve-getpointatdist path (- L_path (setq d (/ pitch 100.0))))
                          p2 (cal "pld(p1,p2,-d)")
                    )
                )
                (setq ang (ang_der path p1))
                (setq p3 (polar p1 ang radius))
                (if (> (c:cal "ang (p1, p2, p3)") 120.0)
                    (progn
                        (setq p3 (polar p1 (- ang pi) radius))
                        (setq p4 (polar p1 ang radius))
                    )
                    (setq p4 (polar p1 (- ang pi) radius))
                )
                (if (= n2 1)
                    (progn
                        (setq p2a (vlax-curve-getpointatdist path (+ step (* pitch 0.63) )))
                        ;;(setq T_start (cal "vec1(pld(p1,p1+nor(p1,p2,p3),-radius),p2a)"))
                        (setq T_start (mapcar '/ (setq fd (vlax-curve-getfirstderiv path (vlax-curve-getstartparam path))) (list (distance '(0.0 0.0 0.0) fd) (distance '(0.0 0.0 0.0) fd) (distance '(0.0 0.0 0.0) fd)))) 
                    )
                )
                (cond
                    ( (= n 0) (setq List_p (cons (cons 11 p3) List_p)) )
                    ( (= n 1) (setq List_p (cons (cons 11 (cal "pld(p1,p1+nor(p1,p2,p3),radius)")) List_p)) )
                    ( (= n 2) (setq List_p (cons (cons 11 p4) List_p)) )
                    ( (= n 3) (setq List_p (cons (cons 11 (cal "pld(p1,p1+nor(p1,p2,p3),-radius)")) List_p)) )
                )
                (setq n (1+ n))
                (if (> n 3) (setq n 0))
            )
            (setq d1 (* pitch 0.63))
            (setq p2a (cal "pld(p1,p2,d1)"))
            ;;(setq T_end (cal "vec1(pld(p1,p1+nor(p1,p2,p3),-radius),p2a)"))
            (setq T_end (mapcar '/ (setq fd (vlax-curve-getfirstderiv path (vlax-curve-getendparam path))) (list (distance '(0.0 0.0 0.0) fd) (distance '(0.0 0.0 0.0) fd) (distance '(0.0 0.0 0.0) fd)))) 
            (entmake
                (append
                    (list
                        '(0 . "SPLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbSpline")
                        '(71 . 3)
                        '(44 . 0.0000001)
                        (cons 12 T_start)
                        (cons 13 T_end)
                        (cons 74 (length List_p))
                    )
                    (reverse List_p)
                )
            )
        )
    )
    (prompt "\n ") (prompt "\n ")
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (setq *error* olderr)
    (princ)
)

;****************************************************************************

(defun H_or_N ( / turn )
    (if (equal method "H")
        (progn
            (initget "N" 6)
            (setq turn
                (cond
                    ( (getdist (strcat
                                   "\nSpecify the Height of turn or [Number of turns] "
                                   (if turn_H (strcat " <" (rtos turn_H) ">: ")": "))) )
                    ( turn_H )
                )
            )
        )
        (progn
            (initget "H" 6)
            (setq turn
                (cond
                    ( (getint (strcat
                                   "\nSpecify the Number of turns or [Height of turn] "
                                   (if turn_N (strcat " <" (rtos turn_N 2 0) ">: ")": "))) )
                    ( turn_N )
                )
            )
        )
    )
    (cond
        ( (equal turn "H") (setq method "H")(H_or_N) )
        ( (equal turn "N") (setq method "N")(H_or_N) )
        ( (and (equal method "H") (equal (type turn) 'REAL)) (setq turn_H turn) )
        ( (and (equal method "N") (equal (type turn) 'INT)) (setq turn_N turn) )
        (T (H_or_N) )
    )
)

;****************************************************************************

(defun ang_der ( :a :b / der :ang )
    (setq der (vlax-curve-getFirstDeriv :a (vlax-curve-getParamAtPoint :a :b)))
    (if (/= (cadr der) 0) (setq :ang (- pi (atan (/ (car der) (cadr der))))))
    (if (= (cadr der) 0) (setq :ang (/ pi 2)))
    :ang
)

;****************************************************************************

(defun myerror ( s )
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (if path (redraw path 4))
    (if (/= s "Function cancelled")
        (princ (strcat "\nError: " s))
    )
    (princ)
)

;****************************************************************************

(vl-load-com)
(or CAL (arxload "GEOMCAL"))

;****************************************************************************

(prompt "\n ") (prompt "\n ")
(princ "\nCreating a Helix (spline) along a path - by Gian Paolo Cattaneo")
(princ "\nHelixAlongPath.lsp loaded.   Type HELIX2 to run")
(princ)