(defun c:DUCT(/ actDoc ang1 ang2 ang3 ptLst enDist
fPt lEnt lObj lPln oldVars oldWd
plEnd plStart1 plStart2 prDir
segLst Start stDist stLst tAng
vlaPln cFlg *error*)

(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(* (if (= dpipeelb "Mitered") 0.5 dpiper/w) Wdth))
(+ (if (= dpipeelb "Mitered") dpipetan 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)
(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 (not (/= "Segmented" dpipeelb "Mitered"))
(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 "Mitered") (< (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 "Mitered") dpipetan 0.0) (*
(if (= dpipeelb "Mitered") 0.5 dpiper/w) (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 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 (not (/= "Segmented" dpipeelb "Mitered"))
(progn
(setq SegCnt 1)
(setq pllst nil)
(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)
); 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)
; (command "_.pline")
; (mapcar 'command ptLst)(command "_c")
; (setq SegCnt 0)
; (while (< SegCnt (1- SegNum))
; (command "_.line" (nth SegCnt ptlst)
; (nth (- (length ptlst) 3 SegCnt) ptlst)
; ""
; )
; (setq SegCnt (1+ SegCnt))
; )
; (setvar "PLINEWID" dpipepWd)
); 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))
); end progn
); end if
(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)
; ); 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" "CMDECHO" "OSMODE")
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)

(if(not dpipepWd)(setq dpipepWd 1.0))
(setq oldWd dpipepWd
oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE"))
); end setq
(if(entlast)(setq lObj(entlast)))
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object))))
(setq dlastelb dpipeelb)
(initget "Mitered Radius Segmented")
(setq dpipeelb (getkword (strcat "\nSpecify elbow type "
(if (= dlastelb "Mitered") "/" "Mitered/")
(if (= dlastelb "Segmented") "/" "Segmented/")
(if (/= "Mitered" dlastelb "Segmented")
(strcat ": ")
"Radius: "))
)
)
(if (or (= dpipeelb "Mitered") (and (not dpipeelb) (= dlastelb "Mitered")))
(progn
(initget 6)
(setq dlasttan dpipetan
dpipetan (getdist (strcat "\nNew elbow throat length : ")
)
)
(if (not dpipetan) (setq dpipetan dlasttan))
(if (not dpipeelb) (setq dpipeelb dlastelb))
(setq dlasttan nil)
)
(progn
(initget 6)
(setq dlastr/w dpiper/w
dpiper/w (getdist (strcat "\nNew centerline r/w factor : ")
)
)
(if (not dpiper/w) (setq dpiper/w dlastr/w))
(if (not dpipeelb) (setq dpipeelb dlastelb))
(setq dlastr/w nil dpiper/w (max dpiper/w 0.5))
)
)
(initget 128)
(while(not cFlg)
(setq fPt
(getpoint
(strcat
"\nSpecify start point or width : " ))); end setq
(cond
((= 'LIST(type fPt))
(setq cFlg T)
); end condition #1
((= 'REAL(type(distof fPt)))
(setq dpipepWd(distof fPt)); end setq
); end condition #2
(T
(princ "\nInvalid option keyword! ")
); end condition #3
); end cond
); end while
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO")
(list 0 dpipepWd 0)); end mapcar
(command "_.pline" fPt)
(setvar "CMDECHO" 1)
(while(= 1(getvar "CMDACTIVE"))
(command pause)
); end while
(setq dpipepwd (getvar "PLINEWID"))
(BodyFunction)
(vla-EndUndoMark actDoc)
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
oldVars); end apply
(princ)
); end of
(c:DUCT)

Advertisements