;-----------------------------------------------------------------------------;
; Fichier: Pipe.lsp ;
; Objet : Permet de dessiner un tuyaux de diametre X avec un # de schedule Y ;
; 'utilisateur doit fournir un point de depart et un point d'arrivee ;
;-----------------------------------------------------------------------------;

(setq pipeversion "V3.0")

(pragma '((unprotect-assign 2pi pi/2 3pi/2 inf dtr rtd tan)))
(setq 2pi (+ pi pi)
pi/2 (/ pi 2)
3pi/2 (/ (+ pi pi pi) 2)
inf 1.7e308
)

; Degree to Radian Conversion & Radian to Degree ;

(defun dtr (a) (* pi (/ a 180.0)))
(defun rtd (a) (* 180.0 (/ a pi)))
(defun tan (a / cosa)
(cond ((zerop (rem a pi)) 0.0)
((zerop (rem a pi/2)) inf)
((zerop (setq cosa (cos a))) inf)
(t (/ (sin a) cosa))))

(pragma '((protect-assign 2pi pi/2 3pi/2 inf dtr rtd tan)))

; ;
; Layers Settings ;
; ;

(setq center (list "Pipe CENTER LINE" 3 "CENTER")
outside (list "Pipe EXTERIOR" 7 "CONTINUOUS")
inside (list "Pipe WALL" 6 "HIDDEN")
)

(setq pipe
(list
(list "1/2" (list "OD" 0.840)(list "5S" 0.065 )(list "5" 0.065)
(list "10S" 0.83)(list "10" 0.083)(list "STD" 0.109)
(list "40" 0.109)(list "XS" 0.147)(list "80" 0.147)
(list "160" 0.187)(list "XXS" 0.294)(list "A" 1.5)
(list "B" 0.625)(list "E" 1.0))
(list "3/4" (list "OD" 1.050)(list "5S"0.065)(list "5" 0.065)
(list "10S" 0.83)(list "10" 0.083)(list "STD" 0.113)
(list "40" 0.113)(list "XS" 0.154)(list "80" 0.154)
(list "160" 0.218)(list "XXS" 0.308)(list "A" 1.125)
(list "B" 0.4375)(list "E" 1.5) (list "C" 1.125))
(list "1" (list "OD" 1.315)(list "5S" 0.065)(list "5" 0.065)
(list "10S" 0.109)(list "10" 0.109)(list "STD" 0.133)
(list "40" 0.133)(list "XS" 0.179)(list "80" 0.179)
(list "160" 0.250)(list "XXS" 0.358)(list "A" 1.5)
(list "B" 0.875)(list "D" 1.0)(list "E" 1.5)
(list "C" 1.5))
(list "1 1/4" (list "OD" 1.66)(list "5S" 0.065)(list "5" 0.065)
(list "10S" 0.109)(list "10" 0.109)(list "STD" 0.140)
(list "40" 0.140)(list "XS" 0.191)(list "80" 0.191)
(list "160" 0.250)(list "XXS" 0.382)(list "A" 1.875)
(list "B" 1.0)(list "D" 1.25)(list "E" 1.5)
(list "C" 1.875))
(list "1 1/2" (list "OD" 1.90)(list "5S" 0.065)(list "5" 0.065)
(list "10S" 0.109)(list "10" 0.109)(list "STD" 0.145)
(list "40" 0.145)(list "XS" 0.20)(list "80" 0.20)
(list "160" 0.281)(list "XXS" 0.4)(list "A" 2.25)
(list "B" 1.125)(list "D" 1.5)(list "E" 1.5)
(list "C" 2.25))
(list "2" (list "OD" 2.375)(list "5S" 0.065)(list "5" 0.065)
(list "10S" 0.109)(list "10" 0.109)(list "STD" 0.154)
(list "40" 0.154)(list "XS" 0.218)(list "80" 0.218)
(list "160" 0.343)(list "XXS" 0.436)(list "A" 3.0)
(list "B" 1.375)(list "D" 2.0)(list "E" 1.5)
(list "C" 2.5))
(list "2 1/2" (list "OD" 2.875)(list "5S" 0.083)(list "5" 0.083)
(list "10S" 0.120)(list "10" 0.120)(list "STD" 0.203)
(list "40" 0.203)(list "XS" 0.276)(list "80" 0.276)
(list "160" 0.375)(list "XXS" 0.375)(list "A" 3.75)
(list "B" 1.75)(list "D" 2.5)(list "E" 1.5)
(list "C" 3))
(list "3" (list "OD" 3.500)(list "5S" 0.083)(list "5" 0.083)
(list "10S" 0.120)(list "10" 0.120)(list "STD" 0.216)
(list "40" 0.216)(list "XS" 0.3)(list "80" 0.3)
(list "160" 0.437)(list "XXS" 0.6)(list "A" 4.5)
(list "B" 2.0)(list "D" 3.0)(list "E" 2.0)
(list "C" 3.375))
(list "3 1/2" (list "OD" 4.0)(list "5S" 0.083)(list "5" 0.083)
(list "10S" 0.120)(list "10" 0.120)(list "STD" 0.226)
(list "40" 0.226)(list "XS" 0.318)(list "80" 0.318)
(list "XXS" 0.636)(list "A" 5.25)(list "B" 2.25)
(list "D" 3.5)(list "E" 2.5)(list "C" 3.75))
(list "4" (list "OD" 4.5)(list "5S" 0.083)(list "5" 0.083)
(list "10S" 0.120)(list "10" 0.120)(list "STD" 0.237)
(list "40" 0.237)(list "60" 0.281)(list "XS" 0.337)
(list "80" 0.337)(list "120" 0.437)(list "160" 0.531)
(list "XXS" 0.674)(list "A" 6.0)(list "B" 2.5)
(list "D" 4.0)(list "E" 2.5)(list "C" 4.125))
(list "4 1/2" (list "OD" 5.0)(list "STD" 0.247)(list "XS" 0.355)
(list "XXS" 0.710))
(list "5" (list "OD" 5.563)(list "5S" 0.109)(list "5" 0.109)
(list "10S" 0.134)(list "10" 0.134)(list "STD" 0.258)
(list "40" 0.258)(list "XS" 0.375)(list "80" 0.375)
(list "120" 0.5)(list "160" 0.625)(list "XXS" 0.750)
(list "A" 7.5)(list "B" 3.125)(list "D" 5.0)
(list "E" 3.0)(LIST "C" 4.875))
(list "6" (list "OD" 6.625)(list "5S" 0.109)(list "5" 0.109)
(list "10S" 0.134)(list "10" 0.134)(list "STD" 0.280)
(list "40" 0.280)(list "XS" 0.432)(list "80" 0.432)
(list "120" 0.562)(list "160" 0.718)(list "XXS" 0.864)
(list "A" 9.0)(list "B" 3.75)(list "D" 6.0)
(list "E" 3.5)(list "C" 5.625))
(list "7" (list "OD" 7.625)(list "STD" 0.301)(list "XS" 0.5)
(list "XXS" 0.875))
(list "8" (list "OD" 8.625)(list "5S" 0.109)(list "5" 0.109)
(list "10S" 0.148)(list "10" 0.148)(list "20" 0.250)
(list "30" 0.277)(list "STD" 0.322)(list "40" 0.322)
(list "60" 0.406)(list "XS" 0.5)(list "80" 0.5)
(list "100" 0.593)(list "120" 0.718)(list "140" 0.812)
(list "160" 0.906)(list "XXS" 0.875)(list "A" 12.0)
(list "B" 5.0)(list "D" 8.0)(list "E" 4.0)(list "C" 7.0))
(list "9" (list "OD" 9.625)(list "STD" 0.342)(list "XS" 0.5)(list "A" nil))
(list "10" (list "OD" 10.75)(list "5S" 0.134)(list "5" 0.134)
(list "10S" 0.165)(list "10" 0.165)(list "20" 0.250)
(list "30" 0.307)(list "STD" 0.365)(list "40" 0.365)
(list "60" 0.5)(list "XS" 0.5)(list "80" 0.593)
(list "100" 0.718)(list "120" 0.843)(list "140" 1.0)
(list "160" 1.125)(list "A" 15.0)(list "B" 6.25)
(list "D" 10.0)(list "E" 5.0)(list "C" 8.5))
(list "11" (list "OD" 11.75)(list "STD" 0.375)(list "XS" 0.5)(list "A" nil))
(list "12" (list "OD" 12.75)(list "5S" 0.156)(list "5" 0.165)
(list "10S" 0.180)(list "10" 0.180)(list "20" 0.250)
(list "30" 0.330)(list "STD" 0.375)(list "40" 0.406)
(list "60" 0.562)(list "XS" 0.5)(list "80" 0.687)
(list "100" 0.843)(list "120" 1.0)(list "140" 1.125)
(list "160" 1.312)(list "A" 18.0)(list "B" 7.5)
(list "D" 12.0)(list "E" 6.0)(list "C" 10.0))
(list "14" (list "OD" 14.0)(list "5S" 0.156)(list "10S" 0.188)
(list "10" 0.250)(list "20" 0.312)(list "30" 0.375)
(list "STD" 0.375)(list "40" 0.437)(list "60" 0.593)
(list "XS" 0.500)(list "80" 0.750)(list "100" 0.937)
(list "120" 1.093)(list "140" 1.25)(list "160" 1.406)
(list "A" 21.0)(list "B" 8.75)(list "D" 14.0)
(list "E" 6.5)(list "C" 11.0))
(list "16" (list "OD" 16.0)(list "5S" 0.165)(list "10S" 0.188)
(list "10" 0.250)(list "20" 0.312)(list "30" 0.375)
(list "STD" 0.375)(list "40" 0.50)(list "60" 0.656)
(list "XS" 0.5)(list "80" 0.843)(list "100" 1.031)
(list "120" 1.218)(list "140" 1.437)(list "160" 1.593)
(list "A" 24.0)(list "B" 10.0)(list "D" 16.0)
(list "E" 7.0)(list "C" 12.0))
(list "18" (list "OD" 18.0)(list "5S" 0.165)(list "10S" 0.188)
(list "10" 0.250)(list "20" 0.312)(list "30" 0.437)
(list "STD" 0.375)(list "40" 0.562)(list "60" 0.75)
(list "XS" 0.5)(list "80" 0.937)(list "100" 1.156)
(list "120" 1.375)(list "140" 1.562)(list "160" 1.781)
(list "A" 27.0)(list "B" 11.25)(list "D" 18.0)
(list "E" 8.0)(list "C" 13.5))
(list "20" (list "OD" 20.0)(list "5S" 0.188)(list "10S" 0.218)
(list "10" 0.250)(list "20" 0.375)(list "30" 0.5)
(list "STD" 0.375)(list "40" 0.593)(list "60" 0.812)
(list "XS" 0.5)(list "80" 1.031)(list "100" 1.28)
(list "120" 1.5)(list "140" 1.75)(list "160" 1.968)
(list "A" 30.0)(list "B" 12.5)(list "D" 20.0)
(list "E" 9.0)(list "C" 15.0))
(list "24" (list "OD" 24.0)(list "5S" 0.218)(list "10S" 0.250)
(list "10" 0.250)(list "20" 0.375)(list "30" 0.562)
(list "STD" 0.375)(list "40" 0.687)(list "60" 0.968)
(list "XS" 0.5)(list "80" 1.218)(list "100" 1.531)
(list "120" 1.812)(list "140" 2.062)(list "160" 2.343)
(list "A" 36.0)(list "B" 15.0)(list "D" 24.0)
(list "E" 10.5)(list "C" 17.0))
)
)

(setq avatar
'( 8 253 253 253 253 9 252 253 253 252 252 252 254 253 253 253 253 253 253 252 253 252 252 253 252 253 9 253 254 253 253 252
8 253 8 252 253 9 253 9 253 253 253 253 9 253 9 253 253 253 253 253 253 253 253 253 253 9 253 253 253 252 9 253
253 9 253 9 9 253 252 253 253 253 253 253 253 253 9 253 253 9 253 9 252 9 253 9 253 253 9 253 9 253 253 9
252 253 9 9 253 9 253 253 252 253 253 253 17 16 14 16 16 16 18 16 39 9 253 9 253 253 253 8 9 9 9 254
9 253 9 253 252 253 253 253 253 9 9 254 17 12 14 14 14 14 14 14 17 9 252 253 252 253 253 252 9 253 253 253
9 253 9 253 253 9 253 253 252 253 253 253 17 12 14 14 14 14 12 12 17 9 253 9 253 253 9 252 253 252 253 9
253 253 253 252 8 253 253 253 253 9 253 9 39 14 12 14 14 12 14 14 27 9 253 253 252 253 253 252 9 253 9 9
9 253 252 252 252 253 253 253 253 253 253 9 17 12 12 14 12 12 12 12 17 9 253 9 253 253 253 253 253 253 9 254
253 253 253 9 9 254 254 9 253 253 253 9 17 12 14 14 14 12 12 14 17 9 252 253 9 253 253 9 253 253 253 253
253 253 253 253 253 253 253 252 253 253 253 253 39 14 12 12 12 12 12 14 17 253 252 253 253 253 9 9 253 253 253 253
252 252 251 251 8 252 251 251 8 8 252 8 29 16 16 16 16 16 18 16 29 9 9 253 253 253 253 9 253 253 253 252
9 8 54 52 52 52 54 54 54 54 54 54 59 251 8 251 251 8 8 8 96 97 253 253 253 253 253 253 253 253 252 253
252 251 54 54 54 54 52 52 52 54 52 54 59 251 251 251 251 251 251 96 94 94 88 8 252 253 253 253 9 252 253 253
8 8 54 54 54 54 54 54 54 54 52 56 59 251 251 8 251 251 99 96 94 94 94 94 75 253 9 253 253 252 253 254
252 8 54 52 52 52 52 52 52 54 54 46 59 8 8 8 8 109 94 94 92 94 94 92 94 97 252 9 9 252 253 9
252 252 54 54 54 54 52 54 54 54 52 54 67 8 8 251 251 94 94 94 92 94 92 92 94 94 96 252 253 252 253 9
253 8 54 52 54 54 52 52 54 52 52 54 67 8 8 251 96 94 94 92 92 94 92 92 94 94 94 96 87 252 253 253
254 252 52 52 52 54 52 54 54 62 52 52 67 8 251 86 92 94 94 94 94 96 96 92 94 94 94 92 94 86 253 253
253 251 54 54 52 54 52 54 54 54 54 54 59 251 99 94 92 94 92 94 92 92 92 94 96 94 94 92 92 92 96 252
9 8 54 52 54 54 52 54 52 54 42 52 66 251 94 94 94 94 92 94 94 92 94 92 92 92 94 92 94 94 97 9
253 251 54 52 52 54 52 54 52 54 54 52 58 96 94 94 94 94 92 94 92 92 92 92 94 94 94 94 94 99 253 253
8 252 251 8 251 8 251 8 8 8 251 251 251 86 94 94 94 94 92 94 94 92 94 94 94 92 94 94 96 253 253 9
253 253 253 253 253 253 253 254 253 252 253 253 253 253 99 94 94 92 92 94 94 94 94 94 94 94 94 96 252 9 253 253
252 253 9 253 253 9 253 253 8 253 253 253 252 253 253 77 94 92 92 94 94 94 96 94 94 94 96 85 253 9 252 253
252 253 9 253 253 253 253 253 253 253 254 253 252 9 253 253 253 86 94 94 94 92 92 94 92 92 97 254 9 9 252 8
254 253 253 253 253 253 253 9 253 252 9 253 253 254 252 253 253 252 89 94 94 94 92 94 92 86 253 253 252 252 253 252
253 253 253 9 252 253 253 253 253 253 9 253 9 253 8 9 254 9 9 8 84 92 92 94 86 8 253 253 253 252 253 253
252 253 252 253 252 9 253 253 252 253 253 9 253 252 252 253 253 253 252 253 253 97 94 94 8 253 253 253 253 253 254 252
253 253 253 253 253 9 9 254 253 9 253 253 252 253 9 253 9 9 253 253 9 253 87 97 9 253 253 9 253 9 9 8
252 253 253 9 253 253 253 253 253 9 252 9 253 9 253 253 9 9 253 253 253 252 253 252 253 253 252 253 252 253 253 253
252 253 252 253 252 253 253 253 253 8 252 9 253 253 253 253 9 253 8 253 9 252 253 252 9 9 252 253 253 253 253 252
8 253 254 9 253 253 253 253 253 252 253 254 252 9 253 253 253 253 253 254 253 253 253 9 9 9 252 253 253 253 253 9)
)

;; ;
;; If the current Version of the DCL is not found in the TEMP directory, ;
;; then the file is generated. ;
;; ;
;; Previous version of the DCL are not erased, User is expected to maintain ;
;; his temp directory manually. ;
;; ;

(defun generatedcl (/ fn f)
(setq fn (strcat (getvar 'TEMPPREFIX) "Pipe" pipeversion ".dcl"))
(if (not (findfile fn)) (make_dcl fn))
(load_dialog fn)
)

(defun make_dcl (fn)
(setq f (open fn "w"))
(write-line "pipe : dialog { "f)
(write-line (strcat "label = \"Pipe " pipeversion " by R.P.\"; ")f)
(write-line " : boxed_column { "f)
(write-line " label = \"Settings\"; "f)
(write-line " : row { "f)
(write-line " : text { "f)
(write-line " label = \"Pipe Size : \"; "f)
(write-line " } "f)
(write-line " : popup_list { "f)
(write-line " horizontal_margin= none; "f)
(write-line " width = 8; "f)
(write-line " fixed_width = true; "f)
(write-line " key = \"siz\"; "f)
(write-line " } "f)
(write-line " } "f)
(write-line " : row { "f)
(write-line " : text { "f)
(write-line " label = \"Pipe Schedule : \"; "f)
(write-line " } "f)
(write-line " : popup_list { "f)
(write-line " horizontal_margin = none; "f)
(write-line " width = 8; "f)
(write-line " fixed_width = true; "f)
(write-line " key = \"sch\"; "f)
(write-line " } "f)
(write-line " } "f)
(write-line " } "f)
(write-line " : boxed_column { "f)
(write-line " label = \"Commands\"; "f)
(write-line " : button { "f)
(write-line " label = \"Elbow &90 Long\"; "f)
(write-line " key = \"elbow90l\"; "f)
(write-line " alignment = centered; "f)
(write-line " width =22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " : button { "f)
(write-line " label = \"Elbow 9&0 Short\"; "f)
(write-line " key = \"elbow90s\"; "f)
(write-line " alignment = centered; "f)
(write-line " width = 22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " : button { "f)
(write-line " label = \"Elbow &180 Long\"; "f)
(write-line " key = \"elbow180l\"; "f)
(write-line " alignment = centered; "f)
(write-line " width = 22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " : button { "f)
(write-line " label = \"Elbow 1&80 Short\"; "f)
(write-line " key = \"elbow180s\"; "f)
(write-line " alignment = centered; "f)
(write-line " width = 22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " : button { "f)
(write-line " label = \"&Tee\"; "f)
(write-line " key = \"tee\"; "f)
(write-line " alignment = centered; "f)
(write-line " width = 22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " : button { "f)
(write-line " label = \" Straight &Pipe \"; "f)
(write-line " key = \"pipe\"; "f)
(write-line " alignment = centered; "f)
(write-line " width = 22; "f)
(write-line " fixed_width = true; "f)
(write-line " } "f)
(write-line " } "f)
(write-line " : row { "f)
(write-line " : column { "f)
(write-line " spacer; "f)
(write-line " : button { "f)
(write-line " label = \"Cancel\"; "f)
(write-line " key = \"cancel\"; "f)
(write-line " alignment = right; "f)
(write-line " width = 12; "f)
(write-line " fixed_width = true; "f)
(write-line " is_default = true; "f)
(write-line " } "f)
(write-line " } "f)
(write-line " : column { "f)
(write-line " : image_button { "f)
(write-line " key = \"avatar\"; "f)
(write-line " aspect_ratio = 1; "f)
(write-line " width = 5.3; "f)
(write-line " fixed_width = true; "f)
(write-line " fixed_height = true; "f)
(write-line " alignment = right; "f)
(write-line " color = -15; "f)
(write-line " } "f)
(write-line " } "f)
(write-line " } "f)
(write-line "} "f)
(close f)
)

;; ;
;; onleft_p by ymg ;
;; ;
;; Returns t if point is strictly on left of vector. ;
;; ;
;; Arguments: p, Point ;
;; v1, First point of vector. ;
;; v2, Second point of vector v1->v2 ;
;; ;
;; ;

(defun onleft_p (p v1 v2 / xp yp)
(setq xp (car p) yp (cadr p))

(minusp
(- (* (- (cadr v1) yp) (- (car v2) xp)) (* (- (car v1) xp) (- (cadr v2) yp)))
)
)

;; ;
;; signum from std-lib ;
;; ;
;; Returns -1, 0 or 1 if the argument is negative zero or positive ;
;; ;

(defun signum (x) (cond ((minusp x) -1) ((zerop x) 0) (t 1)))

;; ;
;; midpoint ;
;; ;
;; Returns The Midpoint Between Point a and Point b ;
;; ;

(defun midpoint (a b) (mapcar (function (lambda (a b) (* (+ a b) 0.5))) a b))

;; ;
;; trunc by Gille Chanteau ;
;; Retourne la liste tronquיe א partir de la premiטre occurrence ;
;; de l'expression (liste complיmentaire de celle retournיe par MEMBER) ;
;; ;
;; Arguments ;
;; expr : l'expression recherchיe ;
;; lst : la liste ;
;; ;

(defun trunc (expr lst)
(if (and lst (not (equal (car lst) expr)))
(cons (car lst) (trunc expr (cdr lst)))
)
)

;; ;
;; mk_lin by ymg ;
;; ;
;; Given p1 and p2 (2 points) creates a line on current layer ;
;; Returns the entity name of the line ;
;; ;

(defun mk_lin (p1 p2)
(entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
)

;; ;
;; mk_lwp by Alan J Thompson (Modified by ymg for closed poly) ;
;; ;
;; Argument: pl, A list of points (2d or 3d) ;
;; Create an LWPolyline at Elevation 0, on Current Layer. ;
;; Return: Entity Name ;
;; ;

(defun mk_lwp (pl / isclosed)
(setq isclosed 0)
(if (equal (car pl) (last pl) 0.001)
(setq isclosed 1 pl (cdr pl))
)

(entmakex
(append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pl))
(cons 70 isclosed)
)
(mapcar '(lambda (p) (cons 10 (trans (list (car p) (cadr p)) 1 0))) pl)
)
)
)

;; ;
;; mk_arc by ymg ;
;; ;
;; Argument: c, Center Point of Arc ;
;; r, Radius of Arc ;
;; a1, Orientation at Start ;
;; a2, Orientation at End ;
;; ;
;; Return: Entity Name ;
;; ;

(defun mk_arc (c r a1 a2)
(entmakex
(list (cons 0 "ARC")
(cons 10 c)
(cons 40 r)
(cons 50 a1)
(cons 51 a2)
)
)
)

;; ;
;; mk_layer by CAB at TheSwamp.org ;
;; Optionnal Arguments by ymg. ;
;; Routine to ENTAKE a Layer entity. ;
;; ;
;; If the layer already exist, it will be: thawed ;
;; set on ;
;; unlocked ;
;; set as the current layer. ;
;; ;

(defun mk_layer (argl / ent lay Color ltype)
(setq lay (car argl) color (cadr argl) ltype (caddr argl))
(if (tblsearch "LAYER" lay)
(progn
(if color (setq ent (entget (tblobjname "LAYER" lay))
ent (subst (cons 62 color) (assoc 62 ent) ent)
ent (entmod ent)
)
)
(if ltype (setq ent (entget (tblobjname "LAYER" lay))
ent (subst (cons 6 ltype) (assoc 6 ent) ent)
ent (entmod ent)
)
)
(vl-cmdf "._Layer" "_Thaw" lay "_On" lay "_UnLock" lay "_Set" lay "" )
)
(entmakex
(list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 lay)
(cons 70 0)
(cons 62 (if (or (null color)(= Color "")) 7 Color))
(cons 6 (if (or (null ltype)(= ltype "")) "Continuous" ltype))
(cons 290 1)
(cons 370 -3)
)
)
)
(setvar 'CLAYER lay)
)

;; delvertex -Gilles Chanteau- gile@TheSwamp 2007-04-23 ;
;; Delete the selected vertex of a polyline (lw, 2d or 3d) ;
;; ;
;; 2007-10_05 widths behavior corrected ;
;; Modified into a callable subroutine by ymg ;

(defun delvertex (pt en / obj os pt en typ plst par blst n wlst)

;; SPLIT-LIST Split a list into sub-lists (gile) ;
;; Arguments ;
;; - lst : the list to be splited ;
;; - num : an integer, the number of items of sub-lists ;

(defun split-list (lst n)
(if lst
(cons (sublist lst 0 n)
(split-list (sublist lst n nil) n)
)
)
)

;; SUBLIST Return a sub-list (gile) ;
;; ;
;; Arguments ;
;; lst : a list ;
;; start : start index for the sub-list (first item = 0) ;
;; leng : sub-list length (or nil) ;
;; ;

(defun sublist (lst start leng / n r)
(if (or (not leng) (vla-object en))
(setq typ (vla-get-ObjectName obj))

(if (and (setq plst (if (= typ "AcDbPolyline")
(split-list (vlax-get obj 'Coordinates) 2)
(split-list (vlax-get obj 'Coordinates) 3)
)
)
(> (length plst) 2)
)
(progn
(setq pt (trans pt 1 0)
par (cond
((equal pt (vlax-curve-getStartPoint en) 1e-9) 0)
((equal pt (vlax-curve-getEndPoint en) 1e-9) (1- (length plst)))
(t (atoi (rtos (vlax-curve-getParamAtPoint en pt) 2)))
)
blst nil
wlst nil
n 0
)
(if (/= typ "AcDb3dPolyline")
(progn
(repeat (length plst)
(if (/= n par)
(setq blst (cons (cons (length blst) (vla-getBulge obj n)) blst))
)
(setq n (1+ n))
)
(if (/= 0 par)
(progn
(vla-getWidth obj (1- par) 'swid1 'ewid1)
(vla-getWidth obj par 'swid2 'ewid2)
(setq wlst (cons (list (1- par) swid1 ewid2) wlst))
)
)
(repeat (- (setq n (1- (fix (vlax-curve-getEndParam en)))) par)
(vla-getWidth obj n 'swid 'ewid)
(setq wlst (cons (list (setq n (1- n)) swid ewid) wlst))
)
)
)
(vlax-put obj 'Coordinates (apply 'append (vl-remove (nth par plst) plst)))
(or (= typ "AcDb3dPolyline")
(and (mapcar '(lambda (x) (vla-setBulge obj (car x) (cdr x))) blst)
(mapcar '(lambda (x) (vla-setWidth obj (car x) (cadr x) (caddr x))) wlst)
)
)
)
(if (> (length plst) 2)
(alert "\nInvalid Entity")
(alert "\nThe polyline had only two vertices.")
)
)

(entget en)
)

;; ;
;; LoadLineType by MICHAEL PUCKETT ;
;; ;

(defun LoadLineTypes ( lineTypeSpec lineTypeFileName / result )
(if (findfile lineTypeFileName)
(vl-catch-all-apply
'(lambda ( )
(vla-load
(vla-get-linetypes
(vla-get-activedocument
(vlax-get-acad-object)
)
)
lineTypeSpec
lineTypeFileName
)
(setq result t)
)
)
)
result
)

;; ;
;; tolayer by Vovka ;
;; ;
;; Given a Layer Name and a Selection Set, ;
;; Will change the layer of all entities in Set to the new one. ;
;; ;

(defun tolayer (lay ss / i ent )
(repeat (setq i (sslength ss))
(entmod
(subst
(cons 8 lay)
(assoc 8 (setq ent (entget (ssname ss (setq i (1- i))))))
ent
)
)
)
)

; ;
; mk_elbow by ymg ;
; ;
; This routine Draws All Elbows ;
;; ;
;; Parameters: ip, Insertion Point ;
;; rc, Dimension A or D from pipe data list ;
;; od, Outside Diameter of Elbow ;
;; thk, Wall Thickness ;
;; sta, Start Angle ;
;; ena, End Angle ;
;; ;
;; Returns: Selection Set of All Entities Created. ;
;; ;
;; Notes: Requires mk_arc, mk_lin and mk_layer ;
;; Variables outside, inside and center are defined in Main Program ;
;; ;

(defun mk_elbow (elbang ipdir rc od thk / ** a1 a2 ang cp dir ena i ip l1 l2
od/2 od/4 p3 p4 r1 r2 r3 r4 rda ss sta tmp)
(setq ip (car ipdir)
dir (cadr ipdir)
ang (dtr elbang)
rda (+ dir (* pi/2 (signum ang)))
sta (+ rda pi)
ena (+ sta ang)
)

(if (minusp ang)
(setq tmp sta sta ena ena tmp)
)

(setq ip (car ipdir)
ss (ssadd)
od/2 (/ od 2)
od/4 (/ od 4)
cp (polar ip rda rc)
r1 (- rc od/2) r2 (+ rc od/2)
r3 (+ r1 thk) r4 (- r2 thk)
** (mk_layer outside)
a1 (mk_arc cp r1 sta ena)
a2 (mk_arc cp r2 sta ena)
l1 (mk_lin (vlax-curve-getStartPoint a1) (vlax-curve-getStartPoint a2))
l2 (mk_lin (vlax-curve-getEndPoint a1) (vlax-curve-getEndPoint a2))
)
(setvar 'PEDITACCEPT 1)
(command "_PEDIT" "_M" a1 a2 l1 l2 "" "_J" "" "")
(ssadd (setq entr (entlast)) ss)
(mk_layer inside)
(ssadd (mk_arc cp r3 sta ena) ss)
(ssadd (mk_arc cp r4 sta ena) ss)
(mk_layer center)
(setq a1 (mk_arc cp rc sta ena)
l1 (if (not (caddr ipdir)) (mk_lin ip (polar ip dir (- od/4))))
p3 (if (minusp ang) (vlax-curve-getstartPoint a1) (vlax-curve-getEndPoint a1))
p4 (if (minusp ang) (polar p3 (- sta pi/2) od/4) (polar p3 (+ ena pi/2) od/4))
l2 (mk_lin p3 p4)
)
(if (caddr ipdir)
(command "_PEDIT" "_M" a1 l2 "" "_J" "" "")
(command "_PEDIT" "_M" a1 l1 l2 "" "_J" "" "")
)
(ssadd (entlast) ss)

(setq pdir (polar ip dir 100)
loop t
)
(while loop
(setq code (grread t 8))
(cond
((= (car code) 5) (cond
((minusp ang) (if (onleft_p (cadr code) ip pdir)
(progn
(repeat (setq i (sslength ss))
(entdel (ssname ss (setq i (1- i))))
)

(mk_elbow (- (rtd ang)) ipdir rc od thk)
)
))
(t (if (not (onleft_p (cadr code) ip pdir))
(progn
(repeat (setq i (sslength ss))
(entdel (ssname ss (setq i (1- i))))
)
(mk_elbow (- (rtd ang)) ipdir rc od thk)
)
))
))
((= (car code) 3) (setq loop nil)) ; Left Click, Exit the loop ;
((= (car code) 25) (setq loop nil)) ; Right Click, Exit the loop ;
((equal code '(2 13)) (setq loop nil)) ; Enter, Exit the loop. ;
((equal code '(2 32)) (setq loop nil)) ; Space, Exit the loop. ;
)
)
)

;; ;
;; get_ip-dir by ymg ;
;; ;
;; On picking an insertion point, the routine computes the direction of ;
;; the nearest endpoint on the Center line on a fitting or oipe length. ;
;; ;
;; Returns: A list of 3 items: (Insertion point, Direction to Endpoint ;
;; Ename of Pickked center line) ;

(defun get_ip-dir (/ ang en ep ip ll sp ss sz ur)
(setq ip (getpoint "\nPick Insertion Point: ")
od/4 (/ od 4)
ll (list (- (car ip) od/4) (- (cadr ip) od/4))
ur (list (+ (car ip) od/4) (+ (cadr ip) od/4))
ss (ssget "_C" ll ur (list (cons 8 (car center))))
)
(cond
((not ss) (setq ang 0))
(t (setq en (ssname ss 0)
pl (listpol en)
sp (vlax-curve-getstartpoint en)
ep (vlax-curve-getendpoint en)
)
(if (< (distance ip sp) (distance ip ep))
(setq ang (angle ip sp) ent (delvertex sp en))
(setq ang (angle ip ep) ent (delvertex ep en))
))
)

(list ip ang en)
)

(defun spipe (/ ang ep ipdir len od/2 os p1 p2 p3 p4 sp ss)
(vla-startundomark *acdoc*)
(setq ipdir (get_ip-dir)
sp (car ipdir)
ep (if (not (caddr ipdir))
(getpoint sp "\n Pick End point of Pipe: ")
(getpoint sp "\n Pick End point of Pipe: ")
)
od/2 (/ od 2)
os (- od/2 thk)
len (* (distance sp ep) fac)
ang (angle sp ep)
ss (ssadd)
)

;drawout of center line
(setq p1 (polar sp ang (- od/2)))
(setq p2 (polar ep ang od/2))
(mk_layer center)
(if (caddr ipdir)
(ssadd (mk_lwp (list sp ep p2)) ss)
(ssadd (mk_lwp (list p1 sp ep p2)) ss)
)
(mk_layer outside)
(setq p1 (polar sp (+ ang pi/2) od/2)
p2 (polar ep (+ ang pi/2) od/2)
p3 (polar sp (- ang pi/2) od/2)
p4 (polar ep (- ang pi/2) od/2)
)
(ssadd (mk_lwp (list p3 p1 p2 p4 p3)) ss)

(mk_layer inside)
(setq p1 (polar sp (- ang pi/2) os)
p2 (polar ep (- ang pi/2) os)
)
(ssadd (mk_lin p1 p2) ss)
(setq p1 (polar sp (+ ang pi/2) os)
p2 (polar ep (+ ang pi/2) os)
)
(ssadd (mk_lin p1 p2) ss)
(vla-endundomark *acdoc*)
)

;-----------------------------------------------------------------------------;

(defun elbow90l () (vla-startundomark *acdoc*) (mk_elbow 90 (get_ip-dir) A od thk) (vla-endundomark *acdoc*))

(defun elbow90s () (vla-startundomark *acdoc*)(mk_elbow 90 (get_ip-dir) D od thk) (vla-endundomark *acdoc*))

(defun elbow180l () (vla-startundomark *acdoc*)(mk_elbow 180 (get_ip-dir) A od thk) (vla-endundomark *acdoc*))

(defun elbow180s () (vla-startundomark *acdoc*)(mk_elbow 180 (get_ip-dir) D od thk) (vla-endundomark *acdoc*))

(defun tee () (vla-startundomark *acdoc*) (mk_tee (get_ip-dir))(vla-endundomark *acdoc*))

(defun mk_tee (ipdir / a1 a2 am code ctr ctra dd dir dm ip ipa ipb l1 l2 l3 l4 loop
od/2 od/4 p1 p10 p11 p12 p2 p3 p4 p5 p6 p7 p8 p9 pdir pm ss up)
(mk_layer outside)
(setvar 'FILLETRAD thk)

(setq ip (car ipdir)
dir (cadr ipdir)
ss (ssadd)
od/2 (/ od 2)
od/4 (/ od 4)
dd (- C od/2)
p1 (polar ip (+ dir pi/2) od/2)
p2 (polar p1 dir dd)
p3 (polar p2 (+ dir pi/2) dd)
p4 (polar p3 dir od)
p5 (polar p4 (+ dir 3pi/2) dd)
p6 (polar p5 dir dd)
p7 (polar p6 (+ dir 3pi/2) od)
p8 (polar p7 (+ dir pi) (+ dd od dd))
a1 (mk_lwp (list p1 p2 p3))
l1 (mk_lin p3 p4)
a2 (mk_lwp (list p4 p5 p6))
l2 (mk_lin p6 p7)
l3 (mk_lin p7 p8)
l4 (mk_lin p8 p1)
ipa (midpoint p3 p4)
ipb (midpoint p6 p7)
pm (midpoint ip ipb)
am (angle pm ipa)
dm (distance pm ipa)
p9 (polar ip (+ dir pi) od/4)
p10 (polar ipb (+ dir 0) od/4)
p11 (polar ipa (+ dir pi/2) od/4)
p12 (polar ipa (+ dir 3pi/2) (+ dd od od/4))
)
(command "_FILLET" "_P" a1)
(command "_FILLET" "_P" a2)
(command "_OFFSET" thk a1 ip "") (ssadd (entlast) ss)
(command "_OFFSET" thk a2 ip "") (ssadd (entlast) ss)
(command "_OFFSET" thk l3 ip "") (ssadd (entlast) ss)
(tolayer (car inside) ss)
(setvar 'PEDITACCEPT 1)
(command "_PEDIT" "_M" a1 l1 a2 l2 l3 l4 "" "_J" "" "")
(ssadd a1 ss)
(mk_layer center)
(ssadd (setq ctr (mk_lwp (list p9 ip ipb p10))) ss)
(ssadd (setq ctra (mk_lwp (list p11 ipa p12))) ss)
(setq pdir (polar ip dir 100)
loop t
up t
)
(while loop
(setq code (grread t 8))
(cond
((= (car code) 5) (if (and up (not (onleft_p (cadr code) ip pdir)))
(progn
(command "_mirror" ss "" ip pdir "_Y")
(setq up nil ipa (polar pm (+ am pi) dm))
)
)
(if (and (not up) (onleft_p (cadr code) ip pdir))
(progn
(command "_mirror" ss "" ip pdir "_Y")
(setq up t ipa (polar pm am dm))
)
))

((= (car code) 3) (if (caddr ipdir) (delvertex p9 ctr)) ; Left Click, Exit the loop ;
(setq loop nil))

((= (car code) 25) (vl-cmdf "_MOVE" ss "" ipa ip) ; Right Click, Insert Tee at Center Outlet, ;
(vl-cmdf "_ROTATE" ss "" ip (if up 90 -90)) ; and Exit the loop ;
(if (caddr ipdir) (delvertex p9 ctra))
(setq loop nil))

((equal code '(2 13)) (setq loop nil)) ; Enter, Exit the loop. ;

((equal code '(2 32)) (setq loop nil)) ; Space, Exit the loop. ;
)
)
)

(defun c:pp () (c:pipe))
(defun c:pipe (/ DDIAG)
(vl-load-com)

;;; Error Handler by ElpanovEvgenyi ;
(defun *error* (msg)
(mapcar 'eval varl)
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(setq varl '("CLAYER" "OSMODE" "CMDECHO" "PEDITACCEPT" "PICKBOX" "ORTHOMODE")
varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
)
(or *acdoc* (setq *acdoc* (vla-get-activedocument (vlax-get-acad-object))))
(setvar 'CMDECHO 0)
(LoadlineTypes "HIDDEN" "ACAD.LIN")
(LoadlineTypes "CENTER" "ACAD.LIN")
(if (= (getvar "LUNITS") 2) (setq fac 25.4) (setq fac 1.0))
(setq sizl (mapcar 'car pipe))
(setq ddiag nil)
(while (not (equal ddiag "cancel"))
(setvar 'ORTHOMODE 1)
(setvar 'OSMODE 32)

(princ "\n!!Choose Command in Dialog Box!! ")
(princ)
(setq dcl_id (generatedcl))
(if (not (new_dialog "pipe" dcl_id "3" (if dlgpos dlgpos '(-1 -1)))) (exit))
(start_list "siz" )
(mapcar 'add_list sizl)
(end_list)
(if (not sizn) (setq sizn "4" sizp (itoa (vl-position sizn sizl)) sch "40"))
(setq size (cdr (assoc sizn pipe))
sizp (itoa (vl-position sizn sizl))
schl (mapcar 'car (cdr (trunc (car (member (assoc "A" size) size)) size)))
schp (if (setq pos (vl-position sch schl)) (itoa pos) "0")
thk (* (cadr (assoc sch size)) fac)
od (* (cadr (assoc "OD" size)) fac)

A (cadr (assoc "A" size))
D (cadr (assoc "D" size))
C (cadr (assoc "C" size))
)
(if A
(progn (setq A (* A fac)) (mode_tile "elbow90l" 0) (mode_tile "elbow180l" 0))
(progn (mode_tile "elbow90l" 1) (mode_tile "elbow180l" 1))
)
(if D
(progn (setq D (* D fac)) (mode_tile "elbow90s" 0) (mode_tile "elbow180s" 0))
(progn (mode_tile "elbow90s" 1) (mode_tile "elbow180s" 1))
)
(if C (progn (setq C (* C fac))(mode_tile "tee" 0)) (mode_tile "tee" 1))

(set_tile "siz" sizp)
(start_list "sch" )
(mapcar 'add_list schl)
(end_list)
(set_tile "sch" schp)

(action_tile "siz" "(setq sizp $value
sizn (nth (atoi sizp) sizl)
size (cdr (assoc sizn pipe))
schl (mapcar 'car (cdr (trunc (car (member (assoc \"A\" size) size)) size)))
schp (if (setq pos (vl-position sch schl)) (itoa pos) \"0\")
sch (nth (atoi schp) schl)
thk (* (cadr (assoc sch size)) fac)
od (* (cadr (assoc \"OD\" size)) fac)

A (cadr (assoc \"A\" size))
D (cadr (assoc \"D\" size))
C (cadr (assoc \"C\" size))
)

(if A
(progn (setq A (* A fac)) (mode_tile \"elbow90l\" 0) (mode_tile \"elbow180l\" 0))
(progn (mode_tile \"elbow90l\" 1) (mode_tile \"elbow180l\" 1))
)
(if D
(progn (setq D (* D fac)) (mode_tile \"elbow90s\" 0) (mode_tile \"elbow180s\" 0))
(progn (mode_tile \"elbow90s\" 1) (mode_tile \"elbow180s\" 1))
)
(if C (progn (setq C (* C fac))(mode_tile \"tee\" 0)) (mode_tile \"tee\" 1))

(start_list \"sch\" )
(mapcar 'add_list schl)
(end_list)
(set_tile \"sch\" schp)"
)
(action_tile "sch" "(setq schp (get_tile \"sch\")
sch (nth (atoi schp) schl)) ")

(action_tile "elbow90l" "(setq ddiag '(elbow90l) dlgpos (done_dialog))")
(action_tile "elbow90s" "(setq ddiag '(elbow90s) dlgpos (done_dialog))")
(action_tile "elbow180l" "(setq ddiag '(elbow180l) dlgpos (done_dialog))")
(action_tile "elbow180s" "(setq ddiag '(elbow180s) dlgpos (done_dialog))")
(action_tile "tee" "(setq ddiag '(tee) dlgpos (done_dialog))")
(action_tile "pipe" "(setq ddiag '(spipe) dlgpos (done_dialog))")
(action_tile "cancel" "(setq ddiag $key dlgpos (done_dialog))")
(start_image "avatar")
(fill_image 0 0 (dimx_tile "avatar") (dimy_tile "avatar") -15)
(setq i 0)
(foreach c avatar
(setq i (1+ i) x (/ i 32) y (- i (* x 32)))
(fill_image x y 1 1 c)
)
(end_image)

(start_dialog)
(unload_dialog dcl_id)

(eval ddiag)

)
(*error* nil)
)
(princ (strcat "\nPipe.lsp " pipeversion))
(princ "\nType PIPE or PP to Start: ")

(c:pp)

;-----------------------------------------------------------------------------;
; THE END ;
;-----------------------------------------------------------------------------;

Advertisements