Community
Visual LISP, AutoLISP and General Customization
cancel
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for 
Show  only  | Search instead for 
Did you mean: 

how can i change radius value in duct lisp

1 REPLY 1
Back to AutoCAD Customization Category
Back to Topic Listing
Reply
Message 1 of 2
E.S.7.9
Advocate
485 Views, 1 Reply
‎05-17-2013 03:52 AM
‎05-17-2013 03:52 AM

how can i change radius value in duct lisp

this is a duct lisp which is i found , could anybody tell me which code line i have to change and how for radius value ? for example if my . " Specify first segment width value " is 1500 then i wanna be my inside fillet radius 1500 / 3 thank you ---------------------------------------------------------------------------------------------------------------------------------------- (defun c:duct(/ actDoc Ang1 Ang2 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 *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 <" (rtos dpipepWd) ">: ")) 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(< 2(length segLst)) (setq ang1 (+(/ pi 2)(angle(caar segLst)(caadr segLst))) ang2 (+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst)))) ); end setq ); end if (if (or (not Start) prDir );end or (setq plStart1 (vlax-curve-getPointAtDist vlaPln stDist) Start T); end setq (setq plStart1 (vlax-curve-getPointAtDist vlaPln (+ stDist(cadar segLst)))); end setq ); 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(cadar segLst))) prDir nil); end setq ); end if (if (< 2(length segLst)) (setq plStart2 (vlax-curve-getPointAtDist vlaPln (+ enDist(cadar segLst)))); 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 (or (not(equal ang1 ang2 0.000001)) (/=(cadar segLst)(nth 2(car segLst))) ); end or (progn (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command ptLst)(command "_c") (setvar "PLINEWID" dpipepWd) ); end progn ); end if (if (not(equal ang1 ang2 0.000001)) (progn (setq lPln (vlax-ename->vla-object(entlast)) tAng(- ang2 ang1) ); end setq (if(minusp tAng)(setq tAng(- tAng))) (if (and (< 0 tAng) (>= pi tAng) ); end and (progn (vla-SetBulge lPln 1 (/(- ang2 ang1)4)) (vla-SetBulge lPln 3 (/(- ang1 ang2)4)) ); end progn (progn (vla-SetBulge lPln 1(/(- ang1 ang2)12)) (vla-SetBulge lPln 3(/(- ang2 ang1)12)) ); 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:dpipe ;FC FILLET WITH SPECIFIED RADIUS (defun C:FC () (command "FILLET" "RADIUS" 6 "FILLET") (princ) )
Report
0 Likes
Reply
1 REPLY 1
Message 2 of 2
E.S.7.9
Advocate
in reply to: E.S.7.9
‎05-17-2013 04:01 AM
‎05-17-2013 04:01 AM 

(defun c:duct(/ actDoc Ang1 Ang2 ptLst enDist
fPt lEnt lObj lPln oldVars oldWd
plEnd plStart1 plStart2 prDir
segLst Start stDist stLst tAng
vlaPln *error*)
(command "-layer" "m" "V-VK" "C" "RED" "" "LT" "CONTINUOUS" "" "" "")
(command "-layer" "set" "V-VK" "")

(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 *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 <" (rtos dpipepWd) ">: "))
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(< 2(length segLst))
(setq ang1
(+(/ pi 2)(angle(caar segLst)(caadr segLst)))
ang2
(+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst))))
); end setq
); end if
(if
(or
(not Start)
prDir
);end or
(setq plStart1
(vlax-curve-getPointAtDist vlaPln
stDist)
Start T); end setq
(setq plStart1
(vlax-curve-getPointAtDist vlaPln
(+ stDist(cadar segLst)))); end setq
); 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(cadar segLst)))
prDir nil); end setq
); end if
(if
(< 2(length segLst))
(setq plStart2
(vlax-curve-getPointAtDist vlaPln
(+ enDist(cadar segLst)))); 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
(or
(not(equal ang1 ang2 0.000001))
(/=(cadar segLst)(nth 2(car segLst)))
); end or
(progn
(setvar "PLINEWID" 0.0)
(command "_.pline")
(mapcar 'command ptLst)(command "_c")
(setvar "PLINEWID" dpipepWd)
); end progn
); end if
(if
(not(equal ang1 ang2 0.000001))
(progn
(setq lPln
(vlax-ename->vla-object(entlast))
tAng(- ang2 ang1)
); end setq
(if(minusp tAng)(setq tAng(- tAng)))
(if
(and
(< 0 tAng)
(>= pi tAng)
); end and
(progn
(vla-SetBulge lPln 1 (/(- ang2 ang1)4))
(vla-SetBulge lPln 3 (/(- ang1 ang2)4))
); end progn
(progn
(vla-SetBulge lPln 1(/(- ang1 ang2)12))
(vla-SetBulge lPln 3(/(- ang2 ang1)12))
); 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:dpipe

;FC FILLET WITH SPECIFIED RADIUS
(defun C:FC ()
	(command "FILLET" "RADIUS" 6 "FILLET")
(princ)
)

 

Report
0 Likes
Reply
Reply

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost

 

Report a website issue