;;; draw batt insulation on an arc, line and polyline.

;;;******* Returns a list containing the endpoints of the selected lwpoly segment *******
(defun balgetseg (selent /)		;elist pts tmp)
  (setq	selpt (osnap (cadr selent) "nea")
	selpt (list (nth 0 selpt) (nth 1 selpt))
	elist (entget (car selent))
  )
  (if (= (cdr (assoc 0 elist)) "LWPOLYLINE")
    (progn
      (setq pts (massoc 10 elist))
      (if (isclosed (car selent))
	(setq pts (append pts (list (car pts))))
      )
      (repeat (1- (length pts))
	(if (equal (angle (car pts) selpt)
		   (angle selpt (cadr pts))
		   0.001
	    )
	  (setq tmp (list (car pts) (cadr pts)))
	)
	(setq pts (cdr pts))
      )
      tmp
    )
  )
)

;;; Returns: T if the lwpoly is closed, nil otherwise
(defun isclosed	(poly)
  (= 1 (logand 1 (cdr (assoc 70 (entget poly)))))
)

;;; Returns a list containing cdrs for every occurence of key in alist
(defun massoc (key alist)
  (apply 'append
	 (mapcar '(lambda (x)
		    (if	(eq (car x) key)
		      (list (cdr x))
		    )
		  )
		 alist
	 )
  )
)

;;; *********** Arc Information **************
(defun ar-info ()
  (setq BS (strcase (getstring "\n Batt Inside or Outside the Arc? [I/O] <O>: "))
        WD (getdist "\n Width of batt insulation: ")
	NS (getint "\n Number of segments: ")
        LI (entget (car LI))
	CT (cdr (assoc 10 LI))
	RA (cdr (assoc 40 LI))
	AN (cdr (assoc 51 LI))
	A1 (cdr (assoc 50 LI))
	SP (polar CT AN RA)
	EP (polar CT A1 RA)
	SA AN
	EA A1
	FIL (rtd (- EA SA))
	AX  (+ SA (/ pi 2))
	AT (/ FIL NS)
	COUNT 0
	SS (ssadd)
  );;setq
);;arc-info

;;; *********** Radian to Degree Conversion **************
(defun rtd (a) (/ (* a 180.0) pi))


;STOPWATCH
(setq stime (fix (getvar "date")))
(setq endtime 2452821);30-jun-2003
(if (> stime endtime) 
(progn (setq stime nil endtime nil) (princ) 
(alert " **********LISP OVERDUE**********
  Email to: nguyen6757@rogers.com ")
(exit)
)
(progn (setq stime nil endtime nil) (princ))
)


;;; *********** Main Program **************
(defun C:BAT (/ AN AX CME COUNT DX E1 E2 E3 E4 E5 EP ET LI
	        M:ERR NU NX OSM P1 P2 P3 P4 P5 P6 P7 SP SS WD)
  (setq M:ERR *ERROR* *ERROR* *MERR*
	CME (getvar "CMDECHO")
	OSM (getvar "OSMODE")
  );;setq
  (setvar "CMDECHO" 0) (setvar "OSMODE" 0)
  (while (null LI)
    (setq LI (entsel "\n Pick arc/line/polyline for batt insulation location: "))
    (if LI
      (cond
        ((= (cdr  (assoc 0 (entget (car LI)))) "ARC")
	 (ar-info)
         (if (or (= BS "") (= BS "O"))
	   (progn
	     (setq P1 (polar SP SA (/ WD 1.25))
                   P2 (polar P1 AX (/ WD 5))
	           P3 (polar P1 AX (/ WD 2.5))
	           P4 (polar SP SA (/ WD 5))
	           P5 (polar P4 AX (/ WD 5))
	           P6 (polar P4 AX (/ WD 2.5))
	           P7 (polar SP AX (/ WD 2.5))
             );;setq
             (command "_.Arc" "C" P4 P5 SP)
             (setq E1 (entlast))
             (command "_.Line" P5 P1 "")
             (setq E2 (entlast))
             (command "_.Line" P5 P3 "")
             (setq E3 (entlast))
             (command "_.Arc" "C" P6 P7 P5)
             (setq E4 (entlast))
             (command "_.Arc"  P1 "C" P2 "A" "180")
             (setq E5 (entlast))
             (command "_.Pedit" E1 "Y" "J" E2 E3 E4 E5 "" "")
             (ssadd (entlast) SS)
             (while (/= COUNT NS)
               (progn
                 (command "_.Copy" (entlast) "" CT CT
		          "_.Rotate" (entlast) "" CT AT)
	         (ssadd (entlast) SS)
	         (setq COUNT (+ COUNT 1))
               );;progn
             );;while
             (command "-Group" "" "*" "" SS "")
	   );;progn
	 );;if O
	 (if (= BS "I")
	   (progn
	     (setq P1 (polar SP (+ SA pi) (/ WD 1.25))
                   P2 (polar P1 AX (/ WD 5))
	           P3 (polar P1 AX (/ WD 2.5))
	           P4 (polar SP (+ SA pi) (/ WD 5))
	           P5 (polar P4 AX (/ WD 5))
	           P6 (polar P4 AX (/ WD 2.5))
	           P7 (polar SP AX (/ WD 2.5))
             );;setq
             (command "_.Arc" "C" P4 SP P5)
	     (setq E1 (entlast))
	     (command "_.Line" P5 P1 "")
	     (setq E2 (entlast))
	     (command "_.Line" P5 P3 "")
	     (setq E3 (entlast))
	     (command "_.Arc" "C" P6 P5 P7)
	     (setq E4 (entlast))
	     (command "_.Arc"  P1 "C" P2 "A" "-180")
	     (setq E5 (entlast))
	     (command "_.Pedit" E1 "Y" "J" E2 E3 E4 E5 "" "")
             (ssadd (entlast) SS)
             (while (/= COUNT NS)
               (progn
                 (command "_.Copy" (entlast) "" CT CT
		          "_.Rotate" (entlast) "" CT AT)
	         (ssadd (entlast) SS)
	         (setq COUNT (+ COUNT 1))
               );;progn
             );;while
             (command "-Group" "" "*" "" SS "")
	   );;progn
	 );;if I
	);;ARC
	((= (cdr  (assoc 0 (entget (car LI)))) "LINE")
         (setq LI (entget (car LI))
	       SP (cdr (assoc 10 LI))
	       EP (cdr (assoc 11 LI))
	       AN (angle SP EP)
	       DX (distance SP EP)
	       AX (+ AN (/ pi 2))
	       WD (getdist "\n Width of batt insulation: ")
	       NX (/ WD 2.5)
	       NU (/ DX NX)
	       P1 (polar SP AX (/ WD 1.25))
	       P2 (polar P1 AN (/ WD 5))
	       P3 (polar P1 AN (/ WD 2.5))
	       P4 (polar SP AX (/ WD 5))
	       P5 (polar P4 AN (/ WD 5))
	       P6 (polar P4 AN (/ WD 2.5))
	       P7 (polar SP AN (/ WD 2.5))
	       SS (ssadd)
         );;setq
         (repeat (fix (+ NU 1))
           (command "_.Arc" "C" P4 SP P5)
           (setq E1 (entlast))
           (command "_.Line" P5 P1 "")
           (setq E2 (entlast))
           (command "_.Arc" P1 "C" P2 "A" "-180")
           (setq E3 (entlast))
           (command "_.Line" P3 P5 "")
           (setq E4 (entlast))
           (command "_.Arc" "C" P6 P5 P7)
           (setq E5 (entlast))
           (command "_Pedit" E1 "Y" "J" E2 E3 E4 E5 "" "")
           (ssadd (entlast) SS)
           (setq SP (polar SP AN NX)
	         P1 (polar P1 AN NX)
	         P2 (polar P2 AN NX)
	         P3 (polar P3 AN NX)
	         P4 (polar P4 AN NX)
	         P5 (polar P5 AN NX)
	         P6 (polar P6 AN NX)
	         P7 (polar P7 AN NX)
           );;setq
         );;repeat
         (command "_.Pedit" SS "J" SS "" "")
        );;LINE
        ((= (cdr (assoc 0 (entget (car LI)))) "LWPOLYLINE")
         (setq LI (balgetseg LI)
	       SP (car LI)
	       EP (cadr LI)
	       AN (angle SP EP)
	       DX (distance SP EP)
	       AX (+ AN (/ pi 2))
	       WD (getdist "\n Width of batt insulation: ")
	       NX (/ WD 2.5)
	       NU (/ DX NX)
	       P1 (polar SP AX (/ WD 1.25))
	       P2 (polar P1 AN (/ WD 5))
	       P3 (polar P1 AN (/ WD 2.5))
	       P4 (polar SP AX (/ WD 5))
	       P5 (polar P4 AN (/ WD 5))
	       P6 (polar P4 AN (/ WD 2.5))
	       P7 (polar SP AN (/ WD 2.5))
	       SS (ssadd)
         );;setq
         (repeat (fix (+ NU 1))
           (command "_.Arc" "C" P4 SP P5)
           (setq E1 (entlast))
           (command "_.Line" P5 P1 "")
           (setq E2 (entlast))
           (command "_.Arc" P1 "C" P2 "A" "-180")
           (setq E3 (entlast))
           (command "_.Line" P3 P5 "")
           (setq E4 (entlast))
           (command "_.Arc" "C" P6 P5 P7)
           (setq E5 (entlast))
           (command "_Pedit" E1 "Y" "J" E2 E3 E4 E5 "" "")
           (ssadd (entlast) SS)
           (setq SP (polar SP AN NX)
	         P1 (polar P1 AN NX)
	         P2 (polar P2 AN NX)
	         P3 (polar P3 AN NX)
	         P4 (polar P4 AN NX)
	         P5 (polar P5 AN NX)
	         P6 (polar P6 AN NX)
	         P7 (polar P7 AN NX)
           );;setq
         );;repeat
         (command "_.Pedit" SS "J" SS "" "")
        );;LWPOLYLINE
        (T (setq LI nil) (alert "\" Select An Arc/Line/Polyline, Dude !\""))
      );;cond
      (alert "\" Nothing Selected, Dude. Try Again !\"")
    );;if LI
  );;while LI
  (setvar "CMDECHO" CME) (setvar "OSMODE" OSM)
  (setq *ERROR* M:ERR M:ERR nil)
  (princ)
);;C:BAL
(princ "\n BATT-INS.LSP  Draws batt insulation on an arc, line and polyline. Start -> BAT")(princ)