Here's a rewrite, hopefully avoiding several errors:
*EDIT* - Added Comments
;; Local defun: angle from three points, as interior value (dgorsman)
(defun get< ( pt1 vertex pt2 / return_angle angle1 angle2 )
(if
(< (setq return_angle (- (angle vertex pt1) (angle vertex pt2))) 0)
(setq return_angle (+ (* pi 2) return_angle)))
(min (- (* pi 2) return_angle) return_angle)
)
(defun AddLWPline (spc pts);(cmwade77)
(setq pts (apply 'append (mapcar '(lambda (pt) (list (car pt) (cadr pt))) pts))
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts)))
(vla-addlightweightpolyline spc pts)
)
;-----------------------------------------------------------------------------------------
;(jvillarreal)
(defun c:CA ( / Doc Mspc pt1 pt2 pt3 pt4 ang1 tanang1 ang2 tanang2
a b num1 DesiredArea div AreaNumber a1 a2 PerpDist)
(vl-load-com)
(while (not pt1)
(setq pt1 (getpoint "\nSelect 1st Base Point:")))
;Require distance btwn base pts
(while (or (not pt2)(zerop (setq b (* 2 (distance pt1 pt2)))))
(setq pt2 (getpoint "\nSelect 2st Base Point:")))
;Require distance/angle btwn pt1&pt3
(while (or (not pt3)(zerop (distance pt1 pt3))
(zerop (rem (- (angle pt1 pt2)(angle pt1 pt3)) pi)))
(setq pt3 (getpoint pt1 "\nPoint on 1st Adjacent Side:")))
;Require distance/angle btwn pt2&pt4
(while (or (not pt4)(zerop (distance pt2 pt4))
(zerop (rem (- (angle pt2 pt1)(angle pt2 pt4)) pi)))
(setq pt4 (getpoint pt2 "\nPoint on 2nd Adjacent Side:")))
(setq Doc (vla-get-activedocument (vlax-get-acad-object))
Mspc (vla-get-modelspace Doc)
;save angles for polar projection
a1 (angle pt1 pt3) a2 (angle pt2 pt4)
;Use interior angle to determine addition or subtraction of triangular area(s)
ang1 (- (get< pt3 pt1 pt2)(/ pi 2))
tanang1 (/ (sin ang1)(cos ang1));right triangle base/height
ang2 (- (get< pt1 pt2 pt4)(/ pi 2))
tanang2 (/ (sin ang2)(cos ang2))
a (+ tanang1 tanang2)
num1 (if (not (equal a 0 1e-10))(/ (expt b 2) (* -8 a)));trapezoid?
;If not trapezoid or rectangle, area is a parallelogram
;Area of a parallelogram = base * height
;Calculate perpedicular distance from pt2 to "pt1->pt3 line" as base,
; height will then be required distance along "pt1->pt3 line"
PerpDist (if (and (not num1)(not (zerop (- ang1 ang2))))(* b 0.5 (sin (- (/ pi 2)(abs ang1))))))
;Require valid Area
;Area greater than 0 entered?
(while (or (not DesiredArea)(zerop DesiredArea)
;within limit if one exists?
(not (if (< num1 0)(> DesiredArea num1)(< DesiredArea num1))))
(setq DesiredArea nil
DesiredArea
(getreal
(if num1;if limit exists, notify user
(strcat "\nEnter Area" (if (< num1 0) " GREATER than " " LESS than ")
(rtos num1 2 20) ":")
"\nEnter Area:"))))
;Prompt for valid Number of areas
(setq AreaNumber
;Check for limit
(if (or (not num1)(< DesiredArea 0 num1)(< num1 0 DesiredArea)(>= (setq div (/ num1 DesiredArea)) 2))
(getint
(strcat "\nEnter Number of Areas to create:"
(if (>= div 2);if limit exists, notify user
(strcat "(1-" (itoa (fix div))")")
""))) 1))
;Require valid Number of areas
(if div
;prompt while limit is exceeded or invalid Number is entered
(while (not (>= (fix div) AreaNumber 1))
(setq AreaNumber (getint (strcat "\nMust be 1-" (itoa (fix div))":")))))
(vla-endundomark doc)
(vla-startundomark doc)
(repeat AreaNumber
(setq b (* 2 (distance pt1 pt2))
c (* -2 DesiredArea)
;if trapezoid, use quadratic formula to determine height
x (if num1 (/ (- (sqrt (- (expt b 2) ( * 4 a c))) b)(* 2 a)))
;if trapezoid, calc distance along legs, else calc rectang height by area/base
p1 (if num1 (/ x (cos ang1))(/ DesiredArea b 0.5))
;if parallelogram, acquire height by area/perpdist
p1 (if perpdist (/ DesiredArea perpdist) p1)
p2 (if num1 (/ x (cos ang2)) p1)
p1 (polar pt1 a1 p1);project point
p2 (polar pt2 a2 p2)
ptlst (mapcar '(lambda (pt)(trans pt 1 0)) (list p1 pt1 pt2 p2))
pt1 p1 pt2 p2)
(vla-put-closed (AddLwpline Mspc ptlst) :vlax-true)
)
(vla-endundomark doc)
(princ)
)