;Semi-auto placement of D.I.P. Hatch pattern in profile. (on MHP sewers)
;
;	AUTHOR: HENRY C. FRANCIS
;		425 N. ASHE ST.
;		SOUTHERN PINES, NC 28387
;              
;		All rights reserved without prejudice.
;	Copyright:	1-30-96
;	Edited:		1-30-96
;
(defun c:diph (/ solss ss count sslen dimsc curel dipx2 whend howm)
  (setq solss (ssget '((0 . "SOLID")))
        ss (ssadd)
        count 0
        sslen (sslength solss)
        dimsc (getvar"dimscale")
        curel (getvar"elevation")
        colr "3"
        llt "-"
        prod "SSWR"
        modf "PATT"
  );setq
  (setvar"elevation"(* 1002 dimsc))
  (setvar"hpang"0)
  (setvar"hpname""ansi31")
  (setvar"hpscale"(/ dimsc 2))
  (c:svlayr)
  (c:mklayr)
  (if (eq sslen 1)
    (progn
      (setq sent (entget(ssname solss count))
            plp1 (cdr(assoc 10 sent))
            plp1 (list(car plp1)(cadr plp1)(* dimsc 1002))
            plp2 (cdr(assoc 11 sent))
            plp2 (list(car plp2)(cadr plp2)(* dimsc 1002))
            plp3 (cdr(assoc 12 sent))
            plp3 (list(car plp3)(cadr plp3)(* dimsc 1002))
            plp4 (cdr(assoc 13 sent))
            plp4 (list(car plp4)(cadr plp4)(* dimsc 1002))
      );setq
      (setq howm (ukword 1 "All Part" "All or Part DIP?" "All"))
      (cond
        ((eq howm "Part")
          (setq dipx (upoint 1 "" "Station of End Between Manholes" nil nil)
                dipx (list(car dipx)(cadr dipx)(* dimsc 1002))
                colr "2"
                modf "NEWW"
          );setq
          (c:mklayr)
          (setq whend (ukword 1 "Right Left Distance" "Right, Left or Distance" "Distance"))
        )
      );cond
      (cond
        ((and(eq howm "Part")(eq whend "Distance"))
          (setq distx (ureal 1 "" "Distance (+ right, - left)" (if distx distx nil)))
          (setq dipx2 (list(+(car dipx)distx)(cadr dipx)(caddr dipx))
                plp1 (inters plp1 plp2 dipx (polar dipx (/ pi 2) 1) nil)
                plp2 (inters plp1 plp2 dipx2 (polar dipx2 (/ pi 2) 1) nil)
                plp3 (inters plp4 plp3 dipx (polar dipx (/ pi 2) 1) nil)
                plp4 (inters plp3 plp4 dipx2 (polar dipx2 (/ pi 2) 1) nil)
          );setq
          (command ".line" plp1 plp3 "")
          (command ".line" plp2 plp4 "")
        )
        ((and(eq howm "Part")(eq whend "Right"))
          (setq plp1 (inters plp1 plp2 dipx (polar dipx (/ pi 2) 1) nil)
                plp3 (inters plp3 plp4 dipx (polar dipx (/ pi 2) 1) nil)
          );setq
          (command ".line" plp1 plp3 "")
        )
        ((and(eq howm "Part")(eq whend "Left"))
          (setq plp2 (inters plp1 plp2 dipx (polar dipx (/ pi 2) 1) nil)
                plp4 (inters plp3 plp4 dipx (polar dipx (/ pi 2) 1) nil)
          );setq
          (command ".line" plp2 plp4 "")
        )
      );cond
      (setq colr "3"
            modf "PATT"
      );setq
      (c:mklayr)
      (command ".pline" plp1 plp2 plp4 plp3 "c")
      (setq ss (ssadd (entlast) ss))
    );progn
    (while (not(eq count sslen))
      (setq sent (entget(ssname solss count))
            plp1 (cdr(assoc 10 sent))
            plp1 (list(car plp1)(cadr plp1)(* dimsc 1002))
            plp2 (cdr(assoc 11 sent))
            plp2 (list(car plp2)(cadr plp2)(* dimsc 1002))
            plp3 (cdr(assoc 12 sent))
            plp3 (list(car plp3)(cadr plp3)(* dimsc 1002))
            plp4 (cdr(assoc 13 sent))
            plp4 (list(car plp4)(cadr plp4)(* dimsc 1002))
      );setq
      (command ".pline" plp1 plp2 plp4 plp3 "c")
      (setq ss (ssadd (entlast) ss)
            count (1+ count)
      );setq
    );while
  );if
  (command ".hatch" "" "" "" "l" "")
  (c:rslayr)
  (command ".erase" ss "")
  (setvar"elevation"curel)
  (princ)
);defun