;elbowReducer.lsp
;elbow reducing
;Clovis Masse
;28-01-2009
;ask for center of smallest diameter D1
;ask for center of elbow C

(defun c:er( / Cs Ce D1 D2 ok ang R1 listPointInfo board hoek Startangle nb)

;;sub
;degre to radian dtor
(defun DtoR (a) (* pi (/ a 180.0)))

(defun c:info ()
(princ(strcat
"\t----\n"
"\nbuild one with\n"
(itoa Section) " las\n"
"radius large section = "(rtos (car tListRayDia))
"\nlarge Diameter = "(rtos (cadr tListRayDia))
))
)
;new diameter
(defun testDia (lRayDia / rayonInt rayonExt diametre Ri1 Di1 rayon)
(setq Ri1 (car lRayDia)
Di1 (cadr lRayDia)
)
(setq rayonInt (*(- Ri1 (/ Di1 2.0))
(cos (/ ang section))
)
)
(setq rayonExt (/(+ Ri1 (/ Di1 2.0))
(cos (/ ang section))
)
)
(setq diametre (- rayonExt rayonInt))
(setq rayon (/(+ rayonExt rayonInt) 2.0))
(list rayon diametre)
)
;make pline
(defun mPline(alist / NewListPoint LPE slop board)
(setq board(vlax-get(vlax-get(vlax-get-acad-object)'activedocument)'modelspace))
(setq NewListPoint '())
(setq LPE(reverse alist))
(foreach point LPE
(setq NewListPoint(cons '0.0 NewListPoint))
(setq NewListPoint(cons (cadr point) NewListPoint))
(setq NewListPoint(cons (car point) NewListPoint))
)
(setq slop(vlax-make-safearray vlax-vbDouble (cons 0 (-(length NewListPoint)1))))
(vlax-safearray-fill slop NewListPoint)
(vla-AddPolyline board slop)
(vlax-release-object board)
)

;make line between outline
(defun mLine(lPExt lPInt / board count)
(setq board(vlax-get(vlax-get(vlax-get-acad-object)'activedocument)'modelspace))
(setq count 0)
(repeat (length lPExt)
(vla-addline board
(vlax-3d-point(nth count lPExt))
(vlax-3d-point(nth count lPInt))
)
(setq count(1+ count))
)
(vlax-release-object board)
)

;;end sub

(setq Cs(getpoint"\nCenter of small section:"))
(setq Ce(getpoint"\nCenter of elbow:"))
(setq D1(getDist"\nDiameter small section:"))
(setq D2(getDist"\nDiameter large section:"))
(setq ok nil)
(initget 3)
(setq ang(dtor(getReal"\nAngle of elbow:")))
(cond ((< D2 D1)(setq temp D1 D1 D2 D2 temp)) ;inverse D1 D2
((= D2 D1)(progn(alert "Both Diameters are equals")(exit)))
)

(setq R1(distance Cs Ce))
(setq listRayDia (list R1 D1))

(setq section 2)
(while (and(not ok)(<= section 1000))
(setq tListRayDia listRayDia) ;start fresh
(setq listPointInfo '())
(repeat section
(setq listPointInfo (cons tListRayDia listPointInfo))
(setq tListRayDia (testDia tListRayDia))
)
(if (= section 100)
(alert "Too many sections > 100")
(c:info)
)

;MAKE list of points
;(polar pt ang dist)
(setq listPointInfo (reverse listPointInfo))
(setq startangle (angle Ce Cs))
(setq hoek (/ ang section)
listPointExt '()
listPointInt '()
nb 0
)
(foreach point listPointInfo
(setq listPointExt
(cons (polar Ce (+(* nb hoek) startangle)(+ (car point)(/(cadr point)2.0))) listPointExt)
)
(setq nb(1+ nb))
)

(setq nb 0)
(foreach point listPointInfo
(setq listPointInt
(cons (polar Ce (+(* nb hoek)startangle)(- (car point)(/(cadr point)2.0))) listPointInt)
)
(setq nb(1+ nb))
)

;make pline
(mPline listPointExt)
(mPline ListPointInt)
(mLine listPointExt listPointInt)
(princ)
)
(c:er)

Advertisements