;;; Draw user defined diameter duct with radius elbow (mline version)

(defun c:rd(/ actDoc ang1 ang2 ang3 ptLst enDist
fPt lEnt lObj lPln oldVars oldWd
plEnd plStart1 plStart2 prDir
segLst Start stDist stLst tAng
vlaPln *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 . 272)'(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(Rad Ang)
(setq Ang(- pi Ang))
(*
(/
(sqrt(-(* 2(expt Rad 2))(* 2(expt Rad 2)(cos Ang))))
(sin(- pi Ang)))(sin(/(- pi(- pi Ang))2)
)
)
); end of SideCalculate

(defun *error*(msg)
(setvar "CMDECHO" 0)
(if lObj
(command "_.erase"(entnext lObj)"")
(command "_.erase"(entlast)"")
); end if
(if oldVars
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
oldVars); end mapcar
); end if
(if stLst
(asmi-LayersStateRestore stLst)
); end if
(if actDoc
(vla-EndUndoMark actDoc)
); end if
(princ "*Cancel* ")
(princ)
); end of *error*

(PipeMLineStyle)

(if(not dpipepWd)(setq dpipepWd 1.0))
(setq oldWd dpipepWd
dpipepWd(getdist
(strcat "\nSpecify first segment width : "))
oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE"))
); end setq
(if(null dpipepWd)(setq dpipepWd oldWd))
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO")
(list 0 dpipepWd 1)); end mapcar
(if(entlast)(setq lObj(entlast)))
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object))))
(setq fPt
(getpoint "\nSpecify start point: ")
); end setq
(command "_.pline" fPt)
(while(= 1(getvar "CMDACTIVE"))
(command pause)
); end while
(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
(list(polar plEnd ang1 (/(cadar segLst)2))
(polar plEnd (+ pi ang1)(/(cadar segLst)2))
(polar plStart2 (+ pi ang2)(/(cadar segLst)2))
(polar plStart2 ang2 (/(cadar segLst)2))
); end list
); 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
(and
(< 2(length segLst))
(or
(not(equal ang1 ang2 0.000001))
(/=(cadar segLst)(nth 2(car segLst)))
); end or
); end and
(progn
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command ptLst)(command "_c")
(setvar "PLINEWID" dpipepWd)
); end progn
); end if
(if
(and
(not(equal ang1 ang2 0.000001))
(vla-object(entlast))
tAng(- ang2 ang1)
); end setq
(if(minusp tAng)(setq tAng(- tAng)))
(if
(and
(= pi tAng)
); end and
(progn
(vla-SetBulge lPln 1 (/(- ang2 ang1)4))
(vla-SetBulge lPln 3 (/(- ang1 ang2)4))
); end progn
(progn
(if(< ang1 ang2)
(setq ang1(+ ang1 pi)
ang2(- ang2 pi)); end setq
(setq ang1(- ang1 pi)
ang2(+ ang2 pi)); end setq
); end if
(vla-SetBulge lPln 1 (/(- ang2 ang1)4))
(vla-SetBulge lPln 3 (/(- ang1 ang2)4))
); end progn
); end if
); end progn
); end if
(if
(=(cadar segLst)(nth 2(car segLst)))
(command "_.mline" "_st" "DUCT_PIPE"
"_S" (cadar segLst) "_J" "_Z"
plStart1 plEnd "")
); end if

(setq segLst(cdr segLst)); end setq
); end while
(command "_.erase" lEnt "")
(asmi-LayersStateRestore stLst)
); end progn
); end if
(vla-EndUndoMark actDoc)
(mapcar 'setvar
'("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
oldVars); end apply
(princ)
); end of c:rd
(c:rd)

Advertisements