Topic: Generate a LISP Routine?

[CAB]

t-bear
do you have a routine to generate the hole template on the main run?

CAB

[t-bear]

Sorry CAB....sure don't.  Our guys just hold the cut pipe up to the cylinder and mark around it.  
 If it's too big, I generate the hole the old-fashioned way....draw 2 circles and transpose their coordinates.....  Our lead man is already of the opinion that I'm no genius,  just the opposite, so he don't push me too hard.
Hey....if one of you came up with THAT routine,  I could be "wonder-boy" (wonder where the boy found THAT!)  :fart:
Hell, they been doin' it this way long 'fore I came here....they'll live. :moon:

[CAB]

Just had to tweak it a little more.
Works great for me...

Code: [Select]

;* FLATPIPE.LSP Draws a flat pattern to be wrapped around a pipe indicating
 ;* Cut line for intersection of two pipes with OPTIONAL LATERAL offset of
 ;* Pipes' Centerlines.
 ;* Logical Preconditions taken from FLATPAT.LSP in New Riders' "MAXIMIZING
 ;* AUTOCAD:Inside Autolisp";
 ;* Mathematical Formula from "DESIGN OF WELDED STRUCTURES" by O.W. Blodgett
 ;* THE JAMES F.LINCOLN ARC WELDING FOUNDATION;
 ;* Worked out by MOSHE AGMON,ISRAEL, i.d. No. at CompuServe 100264,1206
 ;----------------------------------------------------------------------------
 ;     P1 = Optional Start point for pattern curve.
 ;INT_ang = Angle of Intersection between the pipes.
 ;VAR_ang = Varying Angle.
 ;INC_ang = Increament of Varying Angle.
 ;     R1 = Radius of Intersecting Pipe.
 ;     R2 = Radius of Base Pipe.
 ;    PR1 = Circumference of Intersecting Pipe.
 ;  cloff = Lateral Offset of Pipe Centers.  Positive for Right,
 ;                                           Negative for Left Offset.
 ;     DX = Increament Length on "X" axis.      
 ;      X = Length on "X" axis.
 ;  ptlst = List of Points (X,Y).
 ;     GA = Go ahead Flag.
 ;      Q = R1+R2.
 ;      D = Decreament due to Pipes' Offset.
 ;      
 ;----------------------------------------------------------------------------
 ;*  Revised 05/05/2004 CAB  
 ;*  Added some error checking of user input, abort on nil input
 ;*  Added OSmode On/Off to fix potential error
 ;*  Added index lines to output & misc tweaks
 ;----------------------------------------------------------------------------
(defun C:FLATPIPE (/ P1 p2 INT_ang R1 R2 cloff INC_ang VAR_ang PR1 DX X
                   ptlst Q D GA usercmd useros)
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))

  (if (and ;exit if nil input
        (setq P1 (getpoint
               "\nPick Start Point at Lower Left Corner of the Screen: ")
        )
        (setq R1 (getdist "\nEnter Dia. of Intersecting Pipe: "))
        (setq R2 (getdist "\nEnter Dia. of Base Pipe: "))
        (setq INT_ang (getangle "\nEnter Intersection angle: "))
      )
    (progn
      (setq cloff
             (getdist
               (strcat
                 "\nEnter Lateral Offset of Pipe Centers ,Positive"
                 "for Right, Negative for Left Offset, Zero for None: <0.0> "
               )
             )
      )
      (setq cloff   (if cloff cloff 0)); default cloff to 0
      (setq R1      (/ R1 2); diameter to radius
            R2      (/ R2 2); diameter to radius
            INC_ang (/ pi 10) ;Calculate the Variable Angle Increment
            VAR_ang 0.0 ;Initiate VAR_ang.
            PR1     (* R1 pi 2) ;Calculate Circumference of Intersecting Pipe.
            DX      (/ (* R1 pi) 10) ;Calculate the Increment on "X" axis
            X       0.0 ;Initiate "X" Coordinate.
            ptlst   (list P1) ;Initiate list ptlst
            Q       (+ R1 R2)
            ;;Decreament due to Pipes' Offset.
            D       (if (= cloff 0) 0 ;If cloff=0 then let D=0 Else Calculate
                      (- Q (sqrt (- (* Q Q) (* cloff cloff))))
                    ) ;if
      ) ;setq    
      (if (<= (+ R1 (abs cloff)) R2)
        (progn
          (if (< INT_ang 0.35)
            (progn
              (initget "Yes No")
              (prompt "\nAn intersection angle that small may create a")
              (prompt "\nvery long pattern that may be very difficult to")
              (prompt "\nbuild. Do you wish to continue? Yes or <N>o: ")
              (setq ga (getkword))
              (if (= ga nil) (setq ga "No")) ;if    
            ) ;thenprogn
          ) ;if
          (if  (/= ga "No")
            (progn
              ;;Generate Curve Coordinates & Append to List ptlst.    
              (repeat 21 ;It Starts from Zero and Completes 2 PI Radians.
                (setq
                  ptlst  (append ptlst
                            (list (list X ;The rest is Y
                                (+(/ (* (* R1 (- 1 (cos VAR_ang))) (cos INT_ang))
                                     (sin INT_ang))
                                  (/ (- (- R2 (sqrt (- (* R2 R2)
                                               (expt (- (* R1 (sin VAR_ang)) cloff) 2)
                                         )))D)(sin INT_ang)
                                  )))))
                  VAR_ang (+ VAR_ang INC_ang)
                  X       (+ X DX)
                ) ;setq
              ) ;repeat
              (setq ptlst (cdr ptlst))
              ;;Adjust points to start point
              (foreach p ptlst (setq ptlst (subst (mapcar '+ P1 p) p ptlst)))
              (setvar "osmode" 0)
              (command "PLINE" (foreach p ptlst (command p)))
              ;;Join&Fit pattern and make it bylayer color.
              (command "PEDIT" "L" "J" (car ptlst)  "" "F" "X" "CHANGE"
                       "L" "" "P" "C" "BYLAYER" ""
              )
              ;;Adjust LTSCALE to current Limits            
              ;(setvar "LTSCALE"
               ; (/ (- (car (getvar "LIMMAX")) (car (getvar "LIMMIN"))) 25))
             
              ;; Draw 25 unit wrap section, Make tab line Dashed & Red.
              (command "PLINE" "@-5,0" "@-20,0" "@0,-25"
                       (polar (getvar "LASTPOINT") 0 (+ PR1 50))
                       "@0,25" "@-20,0" "" "CHANGE" "L" "" "P"
                       "LT" "" "C" "BYLAYER" ""
              )
              ;; Draw index lines @ 1/4 intervals
              (command ".line" (car ptlst) (setq p1(polar (car ptlst) (* pi 1.5) R2)) "")
              (setq ptlst (reverse ptlst))
              (command ".line" (car ptlst) (setq p2(polar (car ptlst) (* pi 1.5) r2)) p1 "")
              (command ".line" (setq p1(polar p1 0 (/(distance p1 p2)4)))
                       (polar p1 (* pi 0.5) (setq R2 (distance p1 (nth 10 ptlst)))) "")
              (command ".line" (setq p1(polar p1 0 (/(distance p1 p2)3)))
                       (polar p1 (* pi 0.5) r2) "")
              (command ".line" (setq p1(polar p1 0 (/(distance p1 p2)2)))
                       (polar p1 (* pi 0.5) r2) "")
            ) ;progn
          ) ;if
        ) ;elseprogn
        (prompt
          (strcat "\nBase pipe Radius must equal or Exceed Intersecting "
                  "Pipe's Radius Plus Offset.** A B O R T I N G**"))
      ) ;if
    ); progn
  ); endif
  (setvar "CMDECHO" usercmd)
  (setvar "osmode" useros)
  (princ)
) ;defun

[Kerry]

This is a little old, but still worth a look perhaps.
This was built for a metric system, so using imperial may be iffy.
There is a built in allowance for the wall thickness.

added: having a look at this after so long I am thankfull for evolution. The code is a little vulgar in patches.

Regards.kerry

Code: [Select]


;;; Program to develop branch pipe to straight pipe
;;;------------
;;; Property of Kerry Brown
;;; Mar/1991
;;;
(defun p:get ()
  (while (not (p:mmax 20.0
                      1200.0
                      (setq b-dia (p:real 0.0 "Diameter of branch to be developed"))
              )
         )
  )
  (setq rad_b (/ b-dia 2.0))
  (while (not (p:mmax 0 rad_b (setq wt (p:real 0.0 "Wall thickness of branch")))))
  (while (not (p:mmax 4.0
                      360.0
                      (setq nsteps (p:real 180.0 "Number of steps around development"))
              )
         )
  )
  (if (/= 0 (rem nsteps 4))
    (prompt (strcat "Steps set to " (rtos (+ 4.0 (* 4.0 (fix (/ nsteps 4.0)))))))
  )
  (while (not (p:mmax 5.0 90.0 (setq a1 (p:real 45.0 "Angle between pipe centre-lines")))
         )
  )
  (while (not (p:mmax b-dia
                      1200.0
                      (setq m-dia (p:real b-dia "What is diameter of main pipe"))
              )
         )
  )
  (setq a1    (p:110 a1)
        rad_w (- rad_b wt)
        rad_m (/ m-dia 2.0)
  )
  (if (/= b-dia m-dia)
    (progn
      (initget "N F")
      (setq dpoff (getkword
                    "Offset center lines [ Near side or Far side ] < N / F / ENTER for none >"
                  )
      )
      (if dpoff
        (progn
          (while (not
                   (p:mmax 0 (- rad_m rad_b) (setq poff (p:real 0 "Offset between center-lines ")))
                 )
          )
          (if (= dpoff "F")
            (setq poff (- poff))
          )
        )
        (setq poff 0)
      )
    )
    (setq poff 0)
  )
)
;;;-----------
(defun p:dev ()
  (setq temp   0.0
        ystep  0.0
        y-list '()
        w-list '()
        anginc (/ (* pi 2.0) nsteps)
;;;step angle
        disinc (/ (* b-dia pi) nsteps)
;;;step circ' dist
        cang   (* 3 pi)
        cenlen (+ 100 (/ rad_b (p:120 a1)) (/ rad_m (sin a1)))
  )
  (repeat (fix (+ 1 nsteps))
    (princ ".")
    (setq ipt_b  (polar (list 0.0 0.0) cang rad_b)
          ipt_w  (polar (list 0.0 0.0) cang rad_w)
          ystep  (min (+ (- cenlen (/ (* rad_m (cos (p:160 (/ (- poff (car ipt_b)) rad_m)))) (sin a1)))
                         (/ (setq xp (cadr ipt_b)) (p:120 a1))
                      )
                      (+ (- cenlen (/ (* rad_m (cos (p:160 (/ (- poff (car ipt_w)) rad_m)))) (sin a1)))
                         (/ (cadr ipt_w) (p:120 a1))
                      )
                 )
          cang   (- cang anginc)
          y-list (append y-list (list ystep))
          w-list (cons (list xp ystep) w-list)
    )
    (if (> ystep temp)
      (setq temp ystep)
    )
  )
)
;;;-------------
(defun p:txt ()
  (command
;;; "._style" "NORMAL" "ROMANS" 0.0 0.7 0.0 "N" "N" "N"
           "._text"
           (list 11 65)
           3
           0
           (p:time)
           "._text"
           ""
           (strcat "Centers Offset   = " (rtos poff 2 1))
           "._text"
           ""
           (strcat "Template length  = " (rtos temp 2 0))
           "._text"
           ""
           (strcat "Template circumference  = " (rtos (* b-dia pi) 2 0))
           "._text"
           ""
           (strcat "Dim O/A template to WP  = " (rtos cenlen 2 0))
           "._text"
           ""
           (strcat "Main pipe dia  = " (rtos m-dia 2 1))
           "._text"
           ""
           (strcat "Branch size    = " (rtos b-dia 2 1) " x " (rtos wt 2 1) " CHS")
           "._text"
           ""
           (strcat "Angle     = " (angtos a1 0 4))
           "._text"
           (list 10 20)
           6
           0
           (strcat "Drg No : " drgnum)
           "._text"
           ""
           (strcat "Template Mark : " tmark)
  )
)
;;;-------------
(defun p:pic1 ()
  (setq x-step 0.0
        px     (list (* b-dia pi) 0.0)
        0lp    (/ (car y-list) 5)
        1lp    (/ (nth (fix (* nsteps 0.25)) y-list) 5)
        2lp    (/ (nth (fix (* nsteps 0.50)) y-list) 5)
        3lp    (/ (nth (fix (* nsteps 0.75)) y-list) 5)
  )
  (command "._Pline" (list 0.0 0.0) (list 0.0 (car y-list)))
  (while y-list
    (command (list (setq x-step (+ x-step disinc)) (car (setq y-list (cdr y-list))))
    )
  )
  (command "._pline" (getvar "lastpoint") px (list 0.0 0.0) "")
)
;;;----------
(defun p:pic2 (/)
  (setq b-dia  (/ b-dia 5.0)
        m-dia  (/ m-dia 5.0)
        rad_b  (/ rad_b 5.0)
        rad_m  (/ rad_m 5.0)
        rad_w  (/ rad_w 5.0)
        wt     (/ wt 5.0)
        cenlen (/ cenlen 5.0)
        a1     (- (* pi 0.5) a1)
        a1     (if (= a1 0.0)
                 (setq a1 (p:110 0.1))
                 a1
               )
        mlen   (+ 40 (/ b-dia (cos a1)))
        pe0    (list (+ 140 rad_b) 0.0)
        p0     (polar pe0 (* pi 0.5) cenlen)
        pe1    (polar pe0 pi rad_b)
        p1     (polar pe1 (* pi 0.5) 3lp)
        pe2    (polar pe0 0 rad_b)
        p2     (polar pe2 (* pi 0.5) 1lp)
  )
;;;center lines
  (command "._Line"
           pe0
           p0
           ""
           "._Line"
           (p:140 p0 a1 (+ 10 (+ (* rad_m (p:120 a1)) (/ mlen 2))))
           (setq mpcen (polar (getvar "lastpoint") a1 (+ mlen 30 rad_m)))
           (polar mpcen a1 (+ 10 rad_m))
           ""
           "._Line"
           (p:130 mpcen a1 (+ 10 rad_m))
           (p:150 mpcen a1 (+ 10 rad_m))
           ""
           "._Line"
           (setq bcen (p:140 mpcen a1 (/ poff 5)))
           (p:150 bcen a1 (* cenlen (cos a1)))
           ""
  )
;;;branch outline
  (command "._LAYER"
           "S"
           "OBJ3"
           ""
           "._circle"
           mpcen
           rad_m
           "._Line"
           pe1
           p1
           ""
           "._Line"
           (setq mb1 (p:130 pe1 0.0 20))
           (p:140 (getvar "lastpoint") a1 20)
           (p:130 (getvar "lastpoint") a1 m-dia)
           (polar (getvar "lastpoint") a1 mlen)
           (p:150 (getvar "lastpoint") a1 m-dia)
           (setq mb2 (p:140 (getvar "lastpoint") a1 20))
           ""
           "._Line"
           p2
           pe2
           ""
  )
  (command "._LAYER" "S" "OBJHID" "" "._Line" mb2 mb1 "")
  (if (/= 0 wt)
    (command "._Line"
             p1
             (polar p1 0.0 wt)
             (list (+ (car pe1) wt) 0.0)
             ""
             "._Line"
             p2
             (polar p2 pi wt)
             (list (- (car pe2) wt) 0.0)
             ""
    )
  )
;;;intersection
  (setq wx     (car pe0)
        w-list (reverse w-list)
        wp     (car w-list)
  )
  (command "._LAYER"
           "S"
           "OBJ3"
           ""
           "._Pline"
           (list (+ wx (/ (car wp) 5)) (/ (cadr wp) 5))
  )
  (while (setq wp (car (setq w-list (cdr w-list))))
    (command (list (+ wx (/ (car wp) 5)) (/ (cadr wp) 5)))
  )
  (command "")
;;;view
  (setq pend (p:150 bcen a1 (* cenlen (cos a1)))
        lend (p:140 pend a1 rad_b)
        rend (polar pend a1 rad_b)
        0lp  (* 0lp (cos a1))
        2lp  (* 2lp (cos a1))
  )
  (command "._Line"
           lend
           (setq tlend (p:130 lend a1 0lp))
           (polar tlend a1 wt)
           ""
           "._Line"
           rend
           (setq trend (p:130 rend a1 2lp))
           (p:140 trend a1 wt)
           ""
           "._arc"
           tlend
           (p:130 pend a1 (* (cos a1) (- 1lp (* rad_b (p:120 a1)))))
           trend
  )
  (if (> a1 0.002)
    (command "._arc" lend (p:150 pend a1 (* rad_b (sin a1))) rend)
  )
  (command "._LAYER" "S" "OBJHID" "")
  (if (> a1 0.002)
    (command "._arc" lend (p:130 pend a1 (* rad_b (sin a1))) rend)
  )
  (if (/= 0 wt)
    (command "._Line"
             lend
             (polar lend a1 wt)
             (p:130 (getvar "lastpoint") a1 0lp)
             ""
             "._Line"
             rend
             (p:140 rend a1 wt)
             (p:130 (getvar "lastpoint") a1 2lp)
             ""
    )
    (if (> a1 0.002)
      (command "._arc"
               (setq rend (p:140 rend a1 wt))
               (p:130 pend a1 (* rad_w (sin a1)))
               (setq lend (polar lend a1 wt))
               "._arc"
               lend
               (p:150 pend a1 (* rad_w (sin a1)))
               rend
      )
    )
  )
)
;;;------------
;;; Main
(defun c:ppdev ()
  (prompt "\n This programme will develop a template for a ")
  (prompt "\n  BRANCH PIPE to STRAIGHT MAIN PIPE connection.")
  (setq ipnt    (getpoint "\nInsertion point: ")
        comecho (getvar "CMDECHO")
        drgnum  (getstring t "\nDrawing Number eg. AXXX-11 : ")
        tmark   (getstring t "\nTemplate Mark eg. ITEM 11 TOP : ")
  )
  (setvar "CMDECHO" 0)
  (command "._ucs"       "o"    ipnt   "._LAYER"     "M"    "CLIN1"       "C"    4      ""
           "LT"   "CENTER"      ""     "M"    "OBJHID"      "C"    4      ""     "LT"   "HIDDEN"
           ""     "M"    "OBJ3" "C"    2      ""     "M"    "OBJ5" "C"    6      ""     "M"
           "TXT30"       "C"    2      ""     ""
          )
  (p:get)
  (princ "Calculating Development...!  ")
  (p:dev)
  (p:txt)
  (command "._LAYER" "S" "OBJ5" "")
  (p:pic1)
  (command "._LAYER" "S" "CLIN1" "")
  (p:pic2)
  (command "._ucs" "p")
  (setvar "CMDECHO" comecho)
  (princ)
)

;;;----------

(defun p:time (/ d)
  (setq d (rtos (fix (getvar "CDATE")) 2 0)
        d (strcat "Profile calculated "
                  (substr d 7 2)
                  "/"
                  (substr d 5 2)
                  "/"
                  (substr d 1 4)
          )
  )
)
;;;------------------------
(defun p:real (def msg / inp)
  (if (and def (numberp def))
    (setq msg (strcat "\n" msg " <<" (rtos def 2) ">>: "))
    (setq msg (strcat "\n" msg ": "))
  )
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
;;;------------------------
(defun p:mmax (mi ma x /)
  (if (and (>= x mi) (<= x ma))
    (setq x t)
    (progn (setq x nil)
           (prompt (strcat "..between " (rtos mi) " and " (rtos ma) " only please.."))
    )
  )
  x
)
;;;---------------
(defun p:110 (a) (* pi (/ a 180.0)))
(defun p:120 (num)
  (if (= 0 num)
    0.0
    (/ (sin num) (cos num))
  )
)
(defun p:160 (num)
  (if (or (= -1 num) (= 1 num))
    (* pi 0.5)
    (atan (/ num (sqrt (- 1 (* num num)))))
  )
)
(defun p:130 (p a d) (polar p (+ (* pi 0.5) a) d))
(defun p:140 (p a d) (polar p (+ pi a) d))
(defun p:150 (p a d) (polar p (+ (* pi 1.5) a) d))
;;;----------------
(defun *error* (msg)
  (cond ((= msg "Function cancelled") (princ))
        (t (prompt "\nError: ") (princ msg))
  )
)
;;;----------------
(prompt "\n This programme will develop a template for a ")
(prompt "\n  BRANCH PIPE to STRAIGHT MAIN PIPE connection.")
(prompt "\n       TYPE  'ppdev' to start\n")
(princ)
[/img]

[SMadsen]

Excellent, Kerry. I'm just about to finish such a routine myself and needed some input

How important is the pipe wall thicknesses?

[Kerry]

Hi Stig

The allowance for the wall thickness is important if the material is being cut perpendicular to the face. ie say with gas or plasma ...  With larger wall thickness material, sometimes a special cut has to be provided for welding ... in that case template overlapping and blending may be required.


regards.Kerry

[SMadsen]

Thanks Kerry. Learning new stuff every day here. So the angle of the branch actually has to be slightly adjusted with the wall thickness if it's being cut perpendicular to the face? Except if the branch sticks out 90.0 degrees from the main pipe, of course.
If so, it will also have to be adjusted if centerlines are offset? Man ...

[Kerry]

Yep, sort of ...

determine a radial locator.
calculate the inside skin 'length'
calculate the outside skin 'length'
use the shorter as the outside cut locator.

determine the next radial locator.
 < cont >

[Kerry]

This is a little easier ...

I should update these I surpose ..
 ..

Code: [Select]


;;; Program to develop branch pipe to single surface
;;;------------
;;; Property of Kerry Brown
;;; Mar/1991
;;;

(defun p:get ()
  (while (not (p:mmax 20.0
                      1200.0
                      (setq b-dia (p:real 0.0 "Diameter of branch to be developed"))
              )
         )
  )
  (setq rad_b (/ b-dia 2.0))
  (while (not (p:mmax 0 rad_b (setq wt (p:real 0.0 "Wall thickness of branch")))))
  (while (not (p:mmax 4.0
                      360.0
                      (setq nsteps (p:real 180.0 "Number of steps around development"))
              )
         )
  )
  (if (/= 0 (rem nsteps 4))
    (prompt (strcat "Steps set to " (rtos (+ 4.0 (* 4.0 (fix (/ nsteps 4.0)))))))
  )
  (while (not
           (p:mmax 5.0
                   90.0
                   (setq a1 (p:real 45 "Angle between surface & pipe centre-line <5 to 90>"))
           )
         )
  )
  (setq a1    (p:100 a1)
        rad_w (- rad_b wt)
        soff  (getreal "\nSurface offset <if reqd> : ")
        soff  (if (= soff nil)
                0.0
                soff
              )
  )
)
;;;------------
(defun p:dev ()
  (setq temp   0.0
        ystep  0.0
        y-list '()
        w-list '()
        anginc (/ (* pi 2.0) nsteps)
        disinc (/ (* b-dia pi) nsteps)
        cang   (* 3 pi)
        cenlen (+ 100 (/ rad_b (p:110 a1)))
  )
  (repeat (fix (+ 1 nsteps))
    (princ ".")
    (setq ystep  (min (+ cenlen (/ (* rad_b (sin cang)) (p:110 a1)))
                      (+ cenlen (/ (* rad_w (sin cang)) (p:110 a1)))
                 )
          cang   (- cang anginc)
          y-list (append y-list (list ystep))
    )
    (if (> ystep temp)
      (setq temp ystep)
    )
  )
)

;;;-------------
(defun p:txt ()
  (command "._style"
           "NORMAL"
           "ROMANS"
           0.0
           0.7
           0.0
           "N"
           "N"
           "N"
           "._text"
           (list 11 60)
           3
           0
           (p:time)
           "._text"
           ""
           (strcat "Surface Offset   = " (rtos soff 2 1))
           "._text"
           ""
           (strcat "Template length  = " (rtos temp 2 0))
           "._text"
           ""
           (strcat "Template circumference  = " (rtos (* b-dia pi) 2 0))
           "._text"
           ""
           (strcat "Dim O/A template to WP  = " (rtos (+ cenlen (/ soff (sin a1))) 2 0))
           "._text"
           ""
           (strcat "Branch size = " (rtos b-dia 2 1) " x " (rtos wt 2 1) " CHS")
           "._text"
           ""
           (strcat "Angle     = " (angtos a1 0 4))
           "._text"
           (list 15 20)
           6
           0
           (strcat "Drg No : " drgnum)
           "._text"
           ""
           (strcat "Template Mark : " tmark)
  )
)

;;;------------
(defun p:pic1 ()
  (setq x-step 0.0
        px     (list (* b-dia pi) 0.0)
        0lp    (/ (car y-list) 5)
        1lp    (/ (nth (fix (* nsteps 0.25)) y-list) 5)
        2lp    (/ (nth (fix (* nsteps 0.50)) y-list) 5)
        3lp    (/ (nth (fix (* nsteps 0.75)) y-list) 5)
  )
  (command "._Pline" (list 0.0 0.0) (list 0.0 (car y-list)))
  (while y-list
    (command (list (setq x-step (+ x-step disinc)) (car (setq y-list (cdr y-list))))
    )
  )
  (command "._pline" (getvar "lastpoint") px (list 0.0 0.0) "")
)
;;;-------------
(defun p:pic2 (/)
  (setq b-dia  (/ b-dia 5.0)
        rad_b  (/ rad_b 5.0)
        rad_w  (/ rad_w 5.0)
        wt     (/ wt 5.0)
        cenlen (/ cenlen 5.0)
        a1     (- (* pi 0.5) a1)
        a1     (if (= a1 0.0)
                 (setq a1 (p:100 0.1))
                 a1
               )
        pe0    (list (+ 140 rad_b) 0.0)
        p0     (polar pe0 (* pi 0.5) (+ cenlen (/ soff 5)))
        pl0    (polar pe0 (* pi 0.5) 0lp)
        pe1    (polar pe0 pi rad_b)
        p1     (polar pe1 (* pi 0.5) 3lp)
        pe2    (polar pe0 0 rad_b)
        p2     (polar pe2 (* pi 0.5) 1lp)
  )
;;;center lines
  (command "._Line"
           pe0
           p0
           ""
           "._Line"
           (p:120 p0 a1 (+ 20 (/ rad_b (cos a1))))
           (polar p0 a1 (+ 20 (/ rad_b (cos a1))))
           ""
  )
;;;branch outline
  (command "._LAYER" "S" "OBJ3" "" "._Line" pe1 p1 "" "._Line" pe2 p2 "")
;;;intersection
  (command "._line" p1 pl0 p2 "")
;;;hidden
  (command "._LAYER" "S" "OBJHID" "")
  (if (/= 0 wt)
    (command "._Line"
             p1
             (polar p1 0.0 wt)
             (list (+ (car pe1) wt) 0.0)
             ""
             "._Line"
             p2
             (polar p2 pi wt)
             (list (- (car pe2) wt) 0.0)
             ""
    )
  )
)
;;;-------------
;;; Main
(defun c:pfdev ()
  (prompt "\n This programme will develop a template for a")
  (prompt "\n       BRANCH PIPE to FLAT SURFACE connection.\n")
  (setq ipnt    (getpoint "\nInsertion point: ")
        comecho (getvar "CMDECHO")
        drgnum  (getstring t "\nDrawing Number eg. AXXX-11 : ")
        tmark   (getstring t "\nTemplate Mark eg. ITEM 11 TOP : ")
  )
  (setvar "CMDECHO" 0)
  (command "._ucs"       "o"    ipnt   "._LAYER"     "M"    "CLIN1"       "C"    4      ""
           "LT"   "CENTER"      ""     "M"    "OBJHID"      "C"    4      ""     "LT"   "HIDDEN"
           ""     "M"    "OBJ3" "C"    2      ""     "M"    "OBJ5" "C"    6      ""     "M"
           "TXT30"       "C"    2      ""     ""
          )
  (p:get)
  (princ "Calculating Development...!  ")
  (p:dev)
  (p:txt)
  (command "._LAYER" "S" "OBJ5" "")
  (p:pic1)
  (command "._LAYER" "S" "CLIN1" "")
  (p:pic2)
  (command "._ucs" "p")
  (setvar "CMDECHO" comecho)
  (princ)
)
;;;----------
(defun p:time (/ d)
  (setq d (rtos (fix (getvar "CDATE")) 2 0)
        d (strcat "Profile calculated "
                  (substr d 7 2)
                  "/"
                  (substr d 5 2)
                  "/"
                  (substr d 1 4)
          )
  )
)
;;;------------------------
(defun p:real (def msg / inp)
  (if (and def (numberp def))
    (setq msg (strcat "\n" msg " <<" (rtos def 2) ">>: "))
    (setq msg (strcat "\n" msg ": "))
  )
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
;;;------------------------
(defun p:mmax (mi ma x /)
  (if (and (>= x mi) (<= x ma))
    (setq x t)
    (progn (setq x nil)
           (prompt (strcat "..between " (rtos mi) " and " (rtos ma) " only please.."))
    )
  )
  x
)
;;;---------------
(defun p:100 (a) (* pi (/ a 180.0)))
(defun p:110 (num)
  (if (= 0 num)
    0.0
    (/ (sin num) (cos num))
  )
)
(defun p:120 (p a d) (polar p (+ pi a) d))
;;;----------------
(defun *error* (msg)
  (cond ((= msg "Function cancelled") (princ))
        (t (prompt "\nError: ") (princ msg))
  )
)
;;;----------------
(prompt "\n This programme will develop a template for a")
(prompt "\n       BRANCH PIPE to FLAT SURFACE connection.\n")
(prompt "\n       TYPE  'pfdev' to start\n")
(princ)