;;        PipeHatch.lsp 
;;      Created by C. Alan Butler  2003 
;; 
;;    Revision 11/05/2003 
;; 
;;;  PipeH1 Creates ANSI37 hatch perpindicular to the two LINES selected 
;;;  LINES must be parallel (+/-) : Will not work on Polylines 
;;; 
;;;  PipeH2 uses points picked for the four Corners 
;;; 
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED 
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR 
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. 
;;; 
(defun C:PipeH1 (/ usercmd ss er e1 e2 p1 p2 p3 p4 xp1 xp2 xp3 xp4 yp1 
                yp2 yp3 yp4 ang HS RB) 
  (setq usercmd (getvar "CMDECHO") 
        ss      nil 
        er      nil 
        HS      20 ; Hatch Scale 
        RB      "N" ; Retain Border 
  ) 
  (setvar "CMDECHO" 0) 
  (while (not ss) 
    (prompt "\nSelect two parallel lines to hatch") 
    (setq ss (ssget)) ;  ":S"  may be used 
    (Cond 
      ((equal ss nil) 
       (setq er "Nothing selected:") 
      ) 
      ((< (sslength SS) 2) 
       (setq er "too few lines selected.") 
      ) 
      ((> (sslength SS) 2) 
       (setq er "too many lines selected.") 
      ) 
      (T 
       (setq e1 (entget (ssname ss 0))) 
       (setq e2 (entget (ssname ss 1))) 
       (if (and (= (cdr (assoc 0 e1)) "LINE") 
                (= (cdr (assoc 0 e2)) "LINE") 
           ) 
         (progn ; Both are LINES 
           (setq p1 (cdr (assoc 10 e1)) ; Get end points of lines 
                 p2 (cdr (assoc 11 e1)) 
                 p3 (cdr (assoc 10 e2)) 
                 p4 (cdr (assoc 11 e2)) 
           ) 
           (setq xp1 (car p1) ; get x & y values of end points 
                 xp2 (car p2) 
                 xp3 (car p3) 
                 xp4 (car p4) 
                 yp1 (cadr p1) 
                 yp2 (cadr p2) 
                 yp3 (cadr p3) 
                 yp4 (cadr p4) 
           ) 
           ; Correct for cases where two points are not exactly equal (+/- .1) 
           (Setq xp1 (if (equal xp1 xp2 0.1) xp2 xp1)) ; make exactly equal 
           (Setq xp3 (if (equal xp3 xp4 0.1) xp4 xp3)) ; make exactly equal 
           (Setq yp1 (if (equal yp1 yp2 0.1) yp2 yp1)) ; make exactly equal 
           (Setq yp3 (if (equal yp3 yp4 0.1) yp4 yp3)) ; make exactly equal 

           (if (or (> xp1 xp2) (and (= xp1 xp2) (> yp1 yp2))) ;  Swap ends 
             (setq px p1 ; make starting ends the same 
                   p1 p2 ; by swaping ends 
                   p2 px 
             ) 
           ) 
           (if (or (> xp3 xp4) (and (= xp3 xp4) (> yp3 yp4))) 
             (setq px p3 ; make starting ends the same 
                   p3 p4 ; by swaping ends 
                   p4 px 
             ) 
           ) 
           (setq ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi))) ; Hatch @ 90 deg to line 
           (setq pi2 (* pi 2) 
                 a1  (angle p1 p2) ; check for >= 2pi angle, set to 0 or correct to < 2pi 
                 a1  (if (equal a1 pi2 0.0001) 0 (if (> a1 pi2) (- a1 pi2)a1)) 
                 a2  (angle p3 p4) 
                 a2  (if (equal a2 pi2 0.0001) 0 (if (> a2 pi2) (- a2 pi2)a2)) 
           ) 
           (if (not (equal a1 a2 0.1)) ; (margin +/- 0.1 inch) 
             (setq er "lines are not parallel.") 
                ; Lines OK to Hatch 
             (command "_.hatch"       "ANSI37"        HS      ang 
                      ""      RB      p1      p2      p4      p3 
                      "close" "" 
                     ) 
           ) ; endif 
         ) ;end progn 
         (setq er "one or both item(s) not a LINE.") 
       ) ; endif 
      ) ; end (T) 
    ) ; end cond 
  ) ; end  while 
  (if (/= er nil) 
    (alert (strcat "ERROR: " er)) 
  ) 
  (setvar "CMDECHO" usercmd) 
  (princ) 
) ; end defun 
(prompt "\nPipe Hatch routine loaded.  Enter PipeH1 to run.") 
(Princ) 

;;;============================================================================ 
;;;============================================================================ 
;;;    Pipe Hatch Second Version 
;;;============================================================================ 
;;;============================================================================ 
;;;  PipeH2 uses points picked for the four Corners 
;;;  Creates ANSI37 hatch 90 deg to the first two points selected 

(defun C:PipeH2 (/ p1 p2 p3 p4 hs rb ang usercmd ) 
  ;Make 2D point from 3D point 
  (defun 3dP->2dP (3dpt) (list (car 3dpt) (cadr 3dpt))) 

  (setq usercmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nPick boundry points to hatch") 
  (setq p1  (getPoint "\nPick first point:") 
        p2  (getPoint p1 "\nPick along Pipe first:") 
        p3  (getPoint p2 "\nPick across Pipe:") 
        p4  (getPoint p3 "\nPick last point") 
        p1  (3dP->2dP p1) 
        p2  (3dP->2dP p2) 
        p3  (3dP->2dP p3) 
        p4  (3dP->2dP p4) 
        HS      20      ; Hatch Scale 
        RB      "N"     ; Retain Border 

        ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi)) 
  ) 
  (command "_.hatch" "ANSI37" HS ang "" RB p1 p2 p3 p4 "close" "") 
  (setvar "CMDECHO" usercmd) 
  (princ) 
) 
(prompt "\nPipe Hatch routine loaded.  Enter PipeH2 to run.") 
(Princ) 



;;;============================================================================ 
;;;============================================================================ 
;;;    Pipe Hatch Third Version 
;;;============================================================================ 
;;;============================================================================ 
;;;  PipeH3 uses points picked for three Corners, long side then width 
;;;  Creates ANSI37 hatch 90 deg to the first two points selected 

(defun C:PipeH3 (/ p1 p2 p3 p4 hs rb ang usercmd ) 
  ;Make 2D point from 3D point 
  (defun 3dP->2dP (3dpt) (list (car 3dpt) (cadr 3dpt))) 

  (setq usercmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nPick boundry points to hatch") 
  (setq p1  (getPoint "\nPick first point:") 
        p2  (getPoint p1 "\nPick along Pipe first:") 
        p3  (getPoint p2 "\nPick across Pipe:") 
        p1  (3dP->2dP p1) 
        p2  (3dP->2dP p2) 
        p3  (3dP->2dP p3) 
        p4  (polar p1 (angle p2 p3) (distance p2 p3)) 
        HS      20      ; Hatch Scale 
        RB      "N"     ; Retain Border 

        ang (* 180.0 (/ (+ (angle p1 p2) (* pi 0.5)) pi)) 
  ) 
  (command "_.hatch" "ANSI37" HS ang "" RB p1 p2 p3 p4 "close" "") 
  (setvar "CMDECHO" usercmd) 
  (princ) 
) 
(prompt "\nPipe Hatch routine loaded.  Enter PipeH3 to run.") 
(Princ)