I take it back, the routine does produce a correct flat template for the branch
WHEN the osnap is OFF.
Here is a tweeked version, osnaps & input error, still room for improvement.
But seems to work ok.
Thanks t-bear for sharing this routine.
CAB
;* 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.
; e = Lateral Offset of Pipes' Centers. Positive for Right,
;Negative for Left Offset.
; DX = Increament Length on "X" axis.
; X = Length on "X" axis.
; L = List of Points (X,Y).
; GA = Go ahead Flag.
; Q = R1+R2.
; D = Decreament due to Pipes' Offset.
;
(defun C:FLATPIPE (/ P1 INT_ang R1 R2 e INC_ang VAR_ang PR1 DX X L Q D GA)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(if (and
(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 e
(getdist
(strcat
"\nEnter Lateral Offset of Pipes' Centers ,Positive"
"for Right, Negative for Left Offset, Zero for None: <0.0> "
)
)
)
(setq R1 (/ R1 2)
R2 (/ R2 2)
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.
L (list P1) ;Initiate list L
Q (+ R1 R2)
;;Check if "e" has been given a value,if not make it zero.
e (if e e 0)
;;If e=0 then let D=0
D (if (= e 0) 0 ;Else Calculate
;;Decreament due to Pipes' Offset.
(- Q (sqrt (- (* Q Q) (* e e))))
) ;if
) ;setq
(if (<= (+ R1 (abs e)) 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 (or (= ga nil) (= ga "Yes"))
(progn
;;Generate Curve Coordinates & Append to List L.
(repeat 21 ;It Starts from Zero and Completes 2 PI Radians.
(setq
L (append
L
(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)) e) 2)
)
)
)
D
)
(sin INT_ang)
)
)
)
)
)
VAR_ang (+ VAR_ang INC_ang)
X (+ X DX)
) ;setq
) ;repeat
(setq L (cdr L))
;;Adjust points to start point
(foreach p L (setq L (subst (mapcar '+ P1 p) p L)))
(setvar "osmode" 0)
(command "PLINE"
(foreach p L (command p))
) ;command
;;Join&Fit pattern and make it bylayer color.
(command "PEDIT" "L" "J" (car L) "" "F" "X" "CHANGE"
"L" "" "P" "C" "BYLAYER" ""
)
;;Adjust LTSCALE to current Limits
(setvar
"LTSCALE"
(/ (- (car (getvar "LIMMAX")) (car (getvar "LIMMIN"))) 25)
)
;; Draw 25 mm 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" ""
)
) ;thenprogn
) ;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
)
)
(setvar "CMDECHO" usercmd)
(setvar "osmode" useros)
(princ)
) ;defun
