;;; Draw a "Smart" Duct with respect to many features of duct like elbow type, text inside duct, center line, hatch duct and other.

(defun bd( dpipepwd dpipeert)
(if (not (tblsearch "LAYER" "axes"))
(command "_.-layer" "_m" "axes" "_c" "1" "" "_lt" "center" "" "")
)
;centerline properties format '("layer" "color" "ltype" "lweight")
(setq dpropcln '("axes" "Bylayer" "Bylayer" ""))
(if (not (tblsearch "LAYER" "patt"))
(command "_.-layer" "_m" "patt" "_c" "8" "" "_lt" "continuous" "" "")
)
;dproppat = hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight")
(setq dproppat '("ANSI32" 50.0 "patt" "Bylayer" "Bylayer" ""))
(if (not (tblsearch "LAYER" "1"))
(command "_.-layer" "_m" "1" "_c" "7" "" "_lt" "continuous" "" "")
)
;dpropobj = objectline properties format '("layer" "color" "ltype" "lweight")
(setq dpropobj '("1" "Bylayer" "Bylayer" ""))
(wpipe "Radius" dpipeert (/ pi 12) "None" 3 dpipepwd dpipesuf nil)
)
;dproptxt = text/label properties format '("style" "textsize" "layer" "color" "ltype" "lweight")
;(setq dproptxt '("Label" 0.1 "text" "Bylayer" "Bylayer" ""))
;(if (not (tblsearch "STYLE" "Label"))
; (command "_.-style" "Label" "romans" 0.0 1.0 0.0 "_N" "_N" "_N")
; )
;
;(wpipe "Mitered" 6 (/ pi 12) "None" 3 12 "x12" nil)
;(wpipe "Radius" "1.5" (/ pi 12) "All" 3 12 "%%c" nil)
;(defun c:tray( / LAY)
;;dproppat = hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight")
;(setq dproppat '("MUDST" 4.0 "" "8" "Bylayer" ""))
;(wpipe "Chamfered" 6 (/ pi 12) "All" 2 nil " " nil)
;)
;(defun c:pipe()
;(wpipe "Radius" "1.5" (/ pi 12) "None" 3 nil (strcat (if (= (getvar "MEASUREMENT") 0) "\"" "") "%%C") nil)
;)
;(defun c:duct()
;(wpipe nil nil (/ pi 12) "None" nil nil nil nil)
;)
(defun wpipe ( dpipeelb dpipeert dpipetrn dpipepat dpipecln dpipepwd dpipesuf dpipefpt /
actDoc ang1 ang2 ang3 ptLst enDist
dlastfpt
dpipetan
dpiperad ; = specified radius
fPt lEnt lObj lPln oldVars oldWd
plEnd plStart1 plStart2 pwd
prDir dlp txEnt
OldLineType NewLineType
segLst Start stDist stLst tAng
vlaPln cFlg *error*
;dpipewd

)

(vl-load-com)

(defun GetPlineVer(plObj)
(mapcar 'cdr
(vl-remove-if-not
'(lambda(x)(=(car x)10))
(entget plObj)))
); end of GetPLineVer

(defun asmi-PlineSegmentDataList(plObj / cLst outLst)
(setq cLst
(vl-remove-if-not
'(lambda(x)(member(car x) '(10 40 41 42)))
(entget plObj))
outLst '()
); end setq
(while cLst
(if(assoc 40 cLst)
(progn
(setq outLst
(append outLst
(list
(list
(cdr(assoc 10 cLst))
(cdr(assoc 40 cLst))
(cdr(assoc 41 cLst))
(cdr(assoc 42 cLst))
); end list
); end list
); end if
); end setq
(repeat 4
(setq cLst(cdr cLst))
); end repeat
); end progn
(setq outLst
(append outLst
(list
(list
(cdr(assoc 10 cLst))
); end list
); end list
); end append
cLst nil
); end setq
); end if
); end while
outLst
); end of asmi-GetPlineSegmentData

(defun asmi-LayersUnlock(/ restLst)
(setq restLst '())
(vlax-for lay
(vla-get-Layers
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq restLst
(append restLst
(list
(list
lay
(vla-get-Lock lay)
(vla-get-Freeze lay)
); end list
); end list
); end append
); end setq
(vla-put-Lock lay :vlax-false)
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list lay :vlax-false)))
t)
); end vlax-for
restLst
); end of asmi-LayersUnlock

(defun asmi-LayersStateRestore(StateList)
(foreach lay StateList
(vla-put-Lock(car lay)(cadr lay))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list(car lay)(nth 2 lay))))
t)
); end foreach
(princ)
); end of asmi-LayersStateRestore

(defun PipeMLineStyle(/ dxfLst mlDict)
(setq dxfLst
(list'(0 . "MLINESTYLE")'(102 . "{ACAD_REACTORS")'(102 . "}")
'(100 . "AcDbMlineStyle") '(2 . "DUCT_PIPE")
'(70 . 274)'(3 . "")'(62 . 256)'(51 . 1.5708)'(52 . 1.5708)
'(71 . 2)'(49 . 0.5)'(62 . 256)'(6 . "BYBLOCK")
'(49 . -0.5)'(62 . 256)'(6 . "BYBLOCK"))); end setq
(if
(null
(member
(assoc 2 dxfLst)
(dictsearch
(namedobjdict)
"ACAD_MLINESTYLE")))
(progn
(setq mlDict
(cdr
(assoc -1
(dictsearch
(namedobjdict)
"ACAD_MLINESTYLE"))))
(dictadd mlDict
(cdr(assoc 2 dxfLst))(entmakex dxfLst))
); end progn
); end if
); end of PipeMLineStyle

(defun SideCalculate(Wdth Ang / Rad)
(setq Ang(- pi Ang))
(setq Rad(+ (* 0.5 Wdth)(if (/= "Segmented" dpipeelb "Radius") 0.0 (if (numberp
dpiperad) dpiperad (* (- (distof dpiperad) 0.5) Wdth))))
)
(+ (if (/= "Chamfered" dpipeelb "Mitered")
0
(if (= dpipeelb "Mitered")
dpipetan
(+ (* dpipetan 0.5) (/ dpipetan 2.0 (cos (/ Ang 2.0))))
)
)
(*
(/
(sqrt(-(* 2(expt Rad 2))(* 2(expt Rad 2)(cos Ang))))
(sin(- pi Ang)))(sin(/(- pi(- pi Ang))2.0)
)
)
)
); end of SideCalculate

(defun BodyFunction()
(if
(not
(equal lObj(entlast)))
(progn
(setq lEnt(entlast)
stLst(asmi-LayersUnlock)
segLst(asmi-PlineSegmentDataList lEnt)
vlaPln(vlax-ename->vla-object lEnt)
); end setq
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(if (/= 1 (length segLst))
(progn
(if (or (/= (type dpropcln) 'LIST) (not (equal (mapcar 'type dpropcln) '(STR STR STR STR))))
(setq dpropcln '("" "7" "Center2" ""));centerline properties format '("layer" "color" "ltype" "lweight")
)
(if (and (= (logand dpipecln 1) 1) (read (caddr dpropcln)) (not (member (strcase (caddr dpropcln)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (caddr dpropcln))))
(command "_.linetype" "_l" (caddr dpropcln) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "")
)
(if (or (/= (type dproppat) 'LIST) (not (equal (mapcar 'type dproppat) '(STR REAL STR STR STR STR))))
(setq dproppat '("ANSI32" 50.0 "" "8" "" ""));hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight")
)
(if (and (/= dpipepat "None") (read (nth 4 dproppat)) (not (member (strcase (nth 4 dproppat)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (nth 4 dproppat))))
(command "_.linetype" "_l" (nth 4 dproppat) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "")
)
(if (or (/= (type dproptxt) 'LIST) (not (equal (mapcar 'type dproptxt) '(STR REAL STR STR STR STR))))
(setq dproptxt (list (getvar "TEXTSTYLE") (getvar "TEXTSIZE") "" "1" "" ""));text label properties format '("style" "textsize" "layer" "color" "ltype" "lweight")
)
);end progn
);end if
(while (/= 1(length segLst))
(setq stDist
(vlax-curve-getDistAtPoint vlaPln
(caar segLst))
enDist
(vlax-curve-getDistAtPoint vlaPln
(caadr segLst))
); end setq
(if( ang1 ang2)
(setq ang3(- ang1 ang2))
(setq ang3(- ang2 ang1))
); end if
(setq ang3(- pi ang3)
tAng ang3)
(if(minusp ang3)(setq ang3(- ang3)))
); end progn
); end if

(if
(or
(equal ang1 ang2 0.000001)
(= 2(length segLst))
); end or
(setq plEnd
(vlax-curve-getPointAtDist vlaPln
enDist)
prDir T); end setq
(setq plEnd
(vlax-curve-getPointAtDist vlaPln
(- enDist(SideCalculate(cadar segLst)ang3)))
prDir nil); end setq
); end if
(if
(< 2(length segLst))
(setq plStart2
(vlax-curve-getPointAtDist vlaPln
(+ enDist(SideCalculate(cadar segLst)ang3)))); end setq
); end if
(if(< 2(length segLst))
(if
(=(cadar segLst)(nth 2(car segLst)))
(setq ptLst
(mapcar
'(lambda(x)(trans x 0 1)); end lambda
(append
(if (/= dpipeelb "Radius")
(progn
(setq ang4 (apply '(lambda(x)(atan x (sqrt (abs (1- (* x x))))))
(list (sin (- ang1 (/ pi 2.0) (angle plEnd plStart2)))))
)
(setq SegNum (cond ((or (/= dpipeelb "Segmented") (< (abs ang4)
(* (/ 35 360.0) pi))) 2) ((< (abs ang4) (* (/ 55 360.0) pi)) 3)
((< (abs ang4) (* (/ 75 360.0) pi)) 4) (T 5))
)
(setq tan4 (+ (if (= dpipeelb "Segmented") 0
(if (= dpipeelb "Mitered")
dpipetan (+ (* dpipetan 0.5) (/ dpipetan 2.0 (cos ang4)))))
(* (+ (* 0.5 (cadar segLst))
(if (/= dpipeelb "Segmented") 0.0 (if (numberp
dpiperad) dpiperad (* (- (distof dpiperad) 0.5) (cadar segLst)))))
(abs (apply '(lambda(x) (/ (sin x) (cos x))) (list (/ ang4
0.5 (1- SegNum) 2.0))))))
)
(setq mllst (list plEnd (polar plEnd (- ang1 (/ pi 2.0)) tan4)))
(setq SegCnt 0)
(while (< (+ SegCnt 2) SegNum)
(setq mllst (append mllst (list (polar (last mllst)
(+ (angle (cadr (reverse mllst)) (last mllst))
(/ ang4 -0.5 (1- SegNum))) (* tan4 2.0)))
)
SegCnt (1+ SegCnt)
)
)
(setq mllst (append mllst (list PlStart2)))
(setq SegCnt (- (length mllst) 2))
(setq pllst nil)
(if (and (= dpipeelb "Chamfered")
( SegCnt 0)
(setq pllst (append pllst (list (polar (nth SegCnt mllst)
(+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst))
(/ pi 2.0) (/ ang4 0.5 (1- SegNum) -2.0))
(/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0)))))
)
SegCnt (1- SegCnt)
)
)
)
; )
pllst
)
)
(list(polar plEnd ang1 (/(cadar segLst)2)))
(list(polar plEnd (+ pi ang1)(/(cadar segLst)2)))
(if (/= dpipeelb "Radius")
(progn
(setq SegCnt 1)
(setq pllst nil)
(if (and (= dpipeelb "Chamfered")
(< (distance (polar plStart2 (+ pi ang2) (/(cadar segLst)2)) (polar plEnd (+ pi ang1) (/(cadar segLst)2)))
(distance (polar plStart2 ang2 (/(cadar segLst)2)) (polar plEnd ang1 (/(cadar segLst)2)))))
(setq pllst (list(polar (polar plEnd (+ pi ang1) (/(cadar segLst)2)) (- ang1 (/ pi 2)) (* dpipetan 0.5))
(polar (polar plStart2 (+ pi ang2) (/(cadar segLst)2)) (+ ang2 (/ pi 2)) (* dpipetan 0.5)))
)
(while (< SegCnt (1- (length mllst)))
(setq pllst (append pllst (list (polar (nth SegCnt mllst)
(+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst))
(* pi 1.5) (/ ang4 0.5 (1- SegNum) -2.0))
(/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0)))))
)
SegCnt (1+ SegCnt)
)
)
)
(setq mllst (mapcar '(lambda(x)(trans x 0 1)) mllst))
pllst
)
)
(list(polar plStart2 (+ pi ang2)(/(cadar segLst)2)))
(list(polar plStart2 ang2 (/(cadar segLst)2)))
); end append
); end mapcar
); end setq
(setq ptLst
(mapcar
'(lambda(x)(trans x 0 1)); end lambda
(list (polar plStart1 ang1 (/(cadar segLst)2))
(polar plStart1 (+ pi ang1)(/(cadar segLst)2))
(polar(caadr segLst)(+ pi ang2)(/(nth 2(car segLst))2))
(polar(caadr segLst)ang2(/(nth 2(car segLst))2))
); end list
); end mapcar
); end setq
); end if
); end if
(setq plStart1(trans plStart1 0 1)
plEnd(trans plEnd 0 1)
); end setq
(if plStart2
(setq plStart2(trans plStart1 0 1))
); end if
(if (< 2(length segLst))
(if (or (/=(cadar segLst)(nth 2(car segLst)))
(and (/= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001))
); end and
); end or
(progn
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command ptLst)(command "_c")
(setvar "PLINEWID" dpipepWd)
(if (and (/= dpipepat "None") (or (/= (cadar segLst) (nth 2(car segLst))) (and (not (equal ang1 ang2 0.000001)) (= dpipepat "All") (/= "Radius" dpipeelb))))
(command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "")
)
(if (and (= (logand dpipecln 1) 1) (or (equal ang1 ang2 0.000001) (/= "Radius" dpipeelb)))
(progn
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command (if (/= (cadar segLst) (nth 2(car segLst))) (list plStart1 plEnd) mlLst))
(command "")
(setvar "PLINEWID" dpipepWd)
(command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "")
); end progn
)
); end progn
(if (and (= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001)))
(progn
; (command "_.mline" "_st" "DUCT_PIPE" "_S" (cadar segLst) "_J" "_Z")
; (mapcar 'command mlLst)
; (command "")
(setvar "PLINEWID" 0.0)
(setq SegCnt 0)
(while (< SegCnt (1- SegNum))
(command "_.line" (nth SegCnt ptlst)
(nth (- (length ptlst) 3 SegCnt) ptlst)
""
)
(setq SegCnt (1+ SegCnt))
)
(command "_.pline")
(mapcar 'command ptLst)(command "_c")
(setvar "PLINEWID" dpipepWd)
(if (= dpipepat "All")
(command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "")
)
(if (= (logand dpipecln 1) 1)
(progn
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command (if (= (logand dpipecln 3) 3) mlLst (list (car mlLst) (trans (caadr segLst) 0 1) (last mlLst))))
(command "")
(setvar "PLINEWID" dpipepWd)
(command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "")
); end progn
); end if
); end progn
); end if
); end if
); end if
(if
(and (= dpipeelb "Radius")
(not(equal ang1 ang2 0.000001))
(vla-object(entlast))
tAng (abs (- ang2 ang1))
); end setq
(if (> tAng pi)
(if(< ang1 ang2)
(setq ang1(+ ang1 pi)
ang2(- ang2 pi)); end setq
(setq ang1(- ang1 pi)
ang2(+ ang2 pi)); end setq
); end if
); end if
(setq Bulge(/(sin(/(rem(- ang2 ang1)pi)4.0))(cos(/(rem(- ang2 ang1)pi)4.0))))
(vla-SetBulge lPln 1 Bulge)
(vla-SetBulge lPln 3 (- Bulge))
(if
(= dpipepat "All")
(progn
(command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (vla-object(entlast)) 0 Bulge))
(setvar "PLINEWID" dpipepWd)
(command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "")
); end progn
); end if
); end progn
); end if
(if (or (=(cadar segLst)(nth 2(car segLst)))(= 2(length segLst)))
(progn
; (if (=(cadar segLst)(nth 2(car segLst)))
; (command "_.mline" "_st" "DUCT_PIPE" "_S" (cadar segLst) "_J" "_Z" plStart1 plEnd "")
(progn
(setq ptLst
(list (polar plStart1 (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2))
(polar plStart1 (- (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2))
(polar plEnd (- (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2))
(polar plEnd (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2))
)
)
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command ptLst)(command "_c")
(setvar "PLINEWID" dpipepWd)
(if (/= dpipepat "None")
(command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if ( (setq tAng (/ (* 180 (angle plStart1 plEnd)) PI)) 112.5)(= (atof (getvar "ACADVER")) 16.1)
(progn
(setq txEnt (entget (entlast)))
(setq ptLst (textbox txEnt))
(entdel (cdr (assoc -1 txEnt)))
(setq txEnt (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (assoc 7 txEnt) (assoc 8 txEnt) (assoc 40 txEnt) (cons 1 (if (/= nil (cdr (assoc 51 txEnt)) 0)
(strcat "{\\Q" (dectos (deg (cdr (assoc 51 txEnt)))) ";" (cdr (assoc 1 txEnt)) "}") (cdr (assoc 1 txEnt)))) (cons 10 (polar (polar (cdr (assoc 10 txEnt))
(+ (cdr (assoc 50 txEnt)) (/ PI 2.0)) (+ (cadar ptLst) (/ (- (cadadr ptLst) (cadar ptLst)) 2.0))) (cdr (assoc 50 txEnt)) (+ (caar ptLst) (/ (- (caadr ptLst) (caar ptLst)) 2.0))))
(assoc 210 txEnt) (assoc 50 txEnt) '(71 . 5) '(72 . 5) '(90 . 1) '(63 . 1) '(45 . 1.25))
)
(entmake txEnt)
(setq txEnt (subst '(90 . 3) '(90 . 1) (entget (entlast))))
(entmod txEnt)
)
)
(command "_.change" "_l" "" "_p" "_la" (nth 2 dproptxt) "_c" (nth 3 dproptxt) "_lt" (nth 4 dproptxt) "_lw" (nth 5 dproptxt) "")
); end progn
); end if
); end progn
); end if
(setq segLst(cdr segLst)); end setq
); end while
(command "_.erase" lEnt "")
(asmi-LayersStateRestore stLst)
); end progn
); end if
); end of Body Function

(defun *error*(msg)
(if actDoc
(vla-EndUndoMark actDoc)
); end if
(setvar "CMDECHO" 0)
(command "_.undo" "1")
(if oldVars
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE" "CLAYER" "CECOLOR" "CELTYPE" "CELWEIGHT")
oldVars); end mapcar
); end if
(if (not (member msg '("console break" "Function cancelled" "quit / exit abort" "")))
(princ (strcat "\nError: " msg))
(princ)
)
); end of *error*

(PipeMLineStyle)

(setq oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE" "CLAYER" "CECOLOR" "CELTYPE" "CELWEIGHT"))
); end setq
(if(entlast)(setq lObj(entlast)))
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object))))
(if (not (member dpipeelb '("Mitered" "Radius" "Segmented" "Chamfered")))
(progn
(initget "Mitered Radius Segmented Chamfered")
(setq dpipeelb (getkword (strcat "\nSpecify elbow type "
(if (= dlastelb "Chamfered") "/" "Chamfered/")
(if (= dlastelb "Mitered") "/" "Mitered/")
(if (= dlastelb "Segmented") "/" "Segmented/")
(if (not (member dlastelb '("Chamfered" "Mitered" "Segmented")))
(strcat ": ")
"Radius: ")))
)
)
)
(if (not (member dpipeelb '("Chamfered" "Mitered" "Radius" "Segmented"))) (setq dpipeelb dlastelb))
(if (/= "Radius" dpipeelb "Segmented") (setq dpipetan dpipeert) (setq dpiperad dpipeert))
(if (not (and (numberp dlastpwd) (< 0 dlastpwd))) (setq dlastpwd (if (= (getvar "MEASUREMENT") 0) 6.0 100.0)))
(if (/= (type dlastsuf) 'STR) (setq dlastsuf (if (= (getvar "MEASUREMENT") 0) "x6" "x100")))
(if (/= "Radius" dpipeelb "Segmented")
(if (not (and (numberp dpipetan) (< 0 dpipetan)))
(progn
(initget 6)
(setq dpipetan (getdist (strcat "\nSpecify " (if (= dpipeelb "Mitered") "elbow throat" "diagonal chamfer") " length <"
(rtos (if (not (and (numberp dlasttan) (: "))
)
(if (not (and (numberp dpipetan) (< 0 dpipetan))) (setq dpipetan dlasttan))
)
)
(while (not (or (and (numberp dpiperad) (< 0 dpiperad)) (and (= (type dpiperad) 'STR) (< 0 (distof dpiperad)))))
(initget 6 "Throat R/w(d)")
(setq dpiperad (getdist (strcat "\nSpecify radius [" (if (and (= (type dpiperad) 'STR) (< 0 (distof dpiperad)))
"/R/w(d)] <" "Throat/] <") (cond ((and (numberp dlastrad) (< 0 dlastrad)) (rtos dlastrad))
((and (= (type dlastrad) 'STR) (: "))
)
(cond
((= dpiperad "Throat") (setq dpiperad nil dlastrad (if (numberp dlastrad) dlastrad (* (- (distof dlastrad) 0.5) dlastpwd))))
((= dpiperad "R/w(d)") (setq dpiperad nil dlastrad (if (numberp dlastrad) (rtos (* (/ dlastrad dlastpwd) 1.5) 2) dlastrad)))
((numberp dpiperad) (setq dpiperad (if (numberp dlastrad) dpiperad (rtos dpiperad 2))))
(T (setq dpiperad dlastrad))
)
)
)

(if (not (and (numberp dpipetrn) (<= 0 dpipetrn (/ PI 2.0))))
(setq dpipetrn (getangle (strcat "\nSpecify transition angle <"
(angtos (if (and (numberp dlasttrn) (: "))
)
)
(if (not (and (numberp dpipetrn) (<= 0 dpipetrn (/ PI 2.0)))) (setq dpipetrn dlasttrn))

(if (not (member dpipepat '("All" "Straight" "None")))
(progn
(initget "All Straight None")
(setq dpipepat (getkword (strcat "\nSpecify segments to hatch "
(if (= dlastpat "All") "/" "All/")
(if (= dlastpat "Straight") "/" "Straight/")
(if (/= "All" dlastpat "Straight")
(strcat ": ")
"None: ")))
)
)
)
(if (not (member dpipepat '("All" "Straight" "None"))) (setq dpipepat dlastpat))
(if (not (member dpipecln '(0 1 2 3)))
(progn
(initget "Yes No")
(setq dpipecln (getkword (strcat "\nWould you like to have centerline shown? " (progn (setq dlastcln (if (= dlastcln 2) 2 0))"N>"))))
)
(cond
((= dpipecln "Yes")(setq dpipecln (logior dlastcln 1)))
((= dpipecln "No") (setq dpipecln (logand dlastcln -2)))
(T (setq dpipecln dlastcln))
)
(if (and (= (logand dpipecln 1) 1) (/= "Chamfered" dpipeelb "Mitered"))
(progn
(initget "Yes No")
(setq dpipecln (getkword (strcat "\nWould you like elbow centerlines filleted? " "N>")))
)
(cond
((= dpipecln "Yes")(setq dpipecln 3))
((= dpipecln "No") (setq dpipecln 1))
(T (setq dpipecln (logior dlastcln 1)))
)
)
)
)
)
(if (not (member dpipecln '(0 1 2 3))) (setq dpipecln dlastcln))
(if (/= (type dpipesuf) 'STR)
(progn
(initget "Yes No")
(setq dpipesuf (getkword (strcat "\nWould you like to have size label shown? " (progn (if (/= (type dlastsuf) 'STR) (setq dlastsuf " "))"N>"))))
)
(cond
((= dpipesuf "Yes")(setq dpipesuf (if (/= " " dlastsuf) dlastsuf "")))
((= dpipesuf "No") (setq dpipesuf " "))
(T (setq dpipesuf dlastsuf))
)
)
)
(if (/= (type dpipesuf) 'STR) (setq dpipesuf dlastsuf) (setq dlastsuf dpipesuf))
(if (not (and (numberp dpipepwd) (< 0 dpipepwd))) (setq dpipepwd dlastpwd) (setq dlastpwd dpipepwd))
(if (or (/= (type dpropobj) 'LIST) (not (equal (mapcar 'type dpropobj) '(STR STR STR STR))))
(setq dpropobj '("" "" "" ""));objectline properties format '("layer" "color" "ltype" "lweight")
)
(setvar "CMDECHO" 0)
(if (and (read (caddr dpropobj)) (not (member (strcase (caddr dpropobj)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (caddr dpropobj))))
(command "_.linetype" "_l" (caddr dpropobj) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "")
)
(command "_.clayer" (nth 0 dpropobj) "_.cecolor" (nth 1 dpropobj) "_.celtype" (nth 2 dpropobj) "_.celweight" (nth 3 dpropobj))
(while (not (and (numberp dpipepWd) (< 0 dpipepWd) (= 'LIST (type dpipefpt)) (<= 2 (length dpipefpt) 3) (apply 'and (mapcar 'numberp dpipefpt))))
(if (/= " " dpipesuf)
(progn
(initget 128 "Suffix Width")
(setq dlastfpt (getpoint (strcat "\nSpecify start point or [Width/Suffix] : " ))
); end setq
)
(setq dlastfpt (getpoint (strcat "\nSpecify start point or width : " ))
); end setq
)
(cond
((and (= 'LIST (type dlastfpt)) (<= 2 (length dlastfpt) 3) (apply 'and (mapcar 'numberp dlastfpt)))
(setq dpipefpt dlastfpt)
); end condition #1
((and (= 'REAL (type (distof dlastfpt))) (< 0 (distof dlastfpt)))
(setq dpipepWd (distof dlastfpt) dlastpWd dpipepWd); end setq
); end condition #2
((= dlastfpt "Width")
(initget 128)
(setq dpipepWd (getdist (strcat "\nSpecify starting width : ")) dlastpWd dpipepWd); end setq
); end condition #3
((= dlastfpt "Suffix")
(initget 128)
(setq dpipesuf (getstring (strcat "\nEnter text for suffix : " ))
dlastsuf dpipesuf); end setq
); end condition #4
(T
(princ "\nInvalid option keyword! ")
); end condition #5
); end cond
); end while
(mapcar 'setvar '("FILLMODE" "PLINEWID" "CMDECHO") (list 0 dpipepWd 0))
(setq ERRENT (entlast))
(command "_.pline" dpipefpt)
(setq DLP (list dpipefpt))
(while (= (getvar "CMDNAMES") "PLINE")
(setvar "CMDECHO" 0)
(initget (strcat "Width " (if (/= " " dpipesuf) "Suffix " "") "Undo"))
(setq PNT (getpoint (last DLP) (strcat "\nSpecify next point" (if (>= (length DLP) 2) (strcat " or [Undo/Width" (if (/= " " dpipesuf) "/Suffix" "") "]") "") ": ")))
(cond
((/= (getvar "CMDNAMES") "PLINE"))
((= PNT "Width")
(setq PWD (getvar "PLINEWID"))
(princ (strcat "\nSpecify ending width : "))
(command "_Width" "" PAUSE)
(cond
((or (= PWD (getvar "PLINEWID")) ( (distof (angtos dpipetrn 0 16)) 90)))
((= (distof (angtos dpipetrn 0 16)) 90)
(setq PWD (getvar "PLINEWID"))
(command (getvar "LASTPOINT") "_u" (getvar "LASTPOINT") "_w" PWD PWD)
)
(T
(command (last (setq DLP (append DLP (list (polar (getvar "LASTPOINT") (angle (cadr (reverse DLP)) (last DLP))
(/ (abs (- PWD (getvar "PLINEWID"))) 2.0 (/ (sin dpipetrn) (cos dpipetrn))))))))
)
)
)
)
((= PNT "Suffix")
(initget 128)
(setq dpipesuf (getstring (strcat "\nEnter text for suffix : " ))
)
(if (/= dpipesuf dlastsuf)
(progn
(mapcar 'set '(dpipesuf dlastsuf) (list dlastsuf dpipesuf))
(setq dlastpwd (getvar "PLINEWID")
dlastfpt (last DLP)
DLP (list dlastfpt)
)
(while (= (getvar "CMDNAMES") "PLINE") (command ""))
(BodyFunction)
(setq dpipesuf dlastsuf)
(setvar "PLINEWID" dlastpwd)
(command "_.pline" dlastfpt)
)
)
)
((= PNT "Undo")
(command "_Undo")
(setq DLP (reverse (cdr (reverse DLP))))
)
((and (= 'LIST (type PNT)) (= (length DLP) 2) " or [Undo/Width/Suffix]" "") ": "))
; (command PAUSE)
; (initget "Width Suffix Undo")
; (getpoint (last DLP) (strcat "\nSpecify next point" (if (>= (length DLP) 2) " or [Undo/Width/Suffix]" "") ": "))
; (cond
; ((/= (getvar "CMDNAMES") "PLINE"))
; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: W,*: W[I ],*: WI[D ],*: WID[T ],*: WIDTH,*: WIDTH "))
; (setq PWD (getvar "PLINEWID"))
; (princ (strcat "\nSpecify ending width : "))
; (command "" PAUSE)
; (cond
; ((or (= PWD (getvar "PLINEWID")) ( (distof (angtos dpipetrn 0 16)) 90)))
; ((= (distof (angtos dpipetrn 0 16)) 90)
; (setq PWD (getvar "PLINEWID"))
; (command (getvar "LASTPOINT") "_u" (getvar "LASTPOINT") "_w" PWD PWD)
; )
; (T
; (command (last (setq DLP (append DLP (list (polar (getvar "LASTPOINT") (angle (cadr (reverse DLP)) (last DLP))
; (/ (abs (- PWD (getvar "PLINEWID"))) 2.0 (/ (sin dpipetrn) (cos dpipetrn))))))))
; )
; )
; )
; )
; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: S,*: S[U ],*: SU[F ],*: SUF[F ],*: SUFF[I ],*: SUFFI[X ],*: SUFFIX "))
; (initget 128)
; (setq dpipesuf (getstring (strcat "\nEnter text for suffix : " ))
; dlastsuf dpipesuf
; )
; )
; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: U,*: UN,*: UND,*: UNDO"))
; (setq DLP (reverse (cdr (reverse DLP))))
; )
; ((setq DLP (append DLP (list (getvar "LASTPOINT")))))
; )
; )
(setq dlastpwd (getvar "PLINEWID"))
(BodyFunction)
(vla-EndUndoMark actDoc)
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE")
oldVars); end apply
(command "_.regen")
(setq dlastelb dpipeelb dlasttan dpipetan dlastrad dpiperad dlasttrn dpipetrn dlastpat dpipepat dlastcln dpipecln dlastsuf dpipesuf)
(princ)
); end of wpipe
(defun c:sd()
(wpipe nil nil nil nil nil nil nil nil)
)
(c:sd)

Advertisements