Create mesh between two curved pipes in AutoCAD

[Anonymous]

Hello everybody!

I found on this forum a lisp that creates pipes(See pict).But I would like a lisp that draws the turns (elbows) as arc. Is it possible ? can someone modify this lisp? thanks in advance

;;CODE START
;;***DB_Pipe.lsp Copyright (C) Dann Brower 4-19-2006
(defun C:DB_Pipe (/ adoc layrs layr1 layr2 obj obja objb wdth odist tmp 
olducs ptlist)
(vl-load-com)
(command "Undo" "mark")
(setq temperr *error*
*error* pipeerror
olducs (getvar "ucsorg")
)
(command "Ucs" "World")
(setq wdth (GetReal "\nEnter Width of Pipe: ")
odist (/ wdth 2)
ptlist (DB_GetPlinePoints)
tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1)))
)
(vlax-safearray-fill tmp ptlist)
(setq adoc (DB_GetAdoc)
layrs (vla-get-Layers adoc)
layr1 (vla-add layrs "d-pipe")
layr2 (vla-add layrs "d-pipe-mid")
)
(setq obj (vla-addPolyline (vla-get-modelspace adoc) tmp)
obja (car (vlax-invoke obj 'offset (- odist wdth)))
objb (car (vlax-invoke obj 'offset odist))
)
(vla-put-Color layr1 53)
(vla-put-color layr2 17)
(vla-put-Linetype layr2 "HIDDEN")
(vla-put-Layer obja "d-pipe")
(vla-put-linetype obja "ByLayer")
(vla-put-Layer objb "d-pipe")
(vla-put-linetype objb "ByLayer")
(vla-put-Layer obj "d-pipe-mid")
(vla-put-linetype obj "ByLayer")
(vla-put-ConstantWidth obj wdth)
(setq *error* temperr)
(command "Ucs" "Move" olducs)
(command "Redraw")
(princ)
)
;;The following gets and returns the current active AutoCAD document
;;******************************************************************
(defun DB_GetAdoc (/ acadobj adoc)
;;usage = (setq adoc(DB_GetAdoc))
(setq acadobj (vlax-get-acad-object))
(setq adoc (vla-get-ActiveDocument acadobj))
adoc
;;returns result for use in calling program
)
(defun DB_GetPlinePoints (/ ptlist pt1 pt2)
(setq pt1 (Getpoint "Select First Point:")
ptlist pt1
)
(while pt1
(setq pt2 (Getpoint pt1 "\nSelect Next Point: "))
(if pt2
(progn
(grdraw pt1 pt2 1)
(setq ptlist (append ptlist pt2)
pt1 pt2
)
)
(setq pt1 pt2)
)
)
ptlist
)
(defun pipeerror (errmsg)
(princ "\nAn error has occurred!. ")
(terpri)
(prompt errmsg)
(command "ucs" "M" olducs)
(command "undo" "Back")
(setq *error* temperr)
(command "Redraw")
(princ)
)
;;CODE END

[CodeDing]

@Anonymous,

While there are so many unknowns and variables that go into creating pipes, the lisp you provided (minus a few things such as: layering input, UCS input) could essentially be reduced to something like:

(defun c:DB_Pipe ( / lyr w r e)
(vl-load-com)
(setq lyr (getvar 'CLAYER))
;set current layer for pipe
(setvar 'CLAYER "Defpoints")
;get input
(initget 7) (setq w (/ (getreal "\nEnter Width of Pipe: ") 2.0))
(initget 5) (setq r (getreal "\nEnter Universal Elbow Radius: "))
(prompt "\nSelect Centerline Points...")
(command-s "_.PLINE" pause)
;fillet, then offset
(command "_.FILLET" "_r" r "_.FILLET" "_polyline" (setq e (entlast)))
(vla-offset (vlax-ename->vla-object e) w)
(vla-offset (vlax-ename->vla-object e) (* -1.0 w))
;restore layer & finish quietly
(setvar 'CLAYER lyr)
(princ "\nPipe Complete...")
(princ)
);defun

...but one-size does not usually fit all.. this may need to be edited further... Can you elaborate further on what layering needs to be changed? do you change your ucs? can the elbow radius be uniform, or will it change?

Best,

~DD

[Anonymous]

Hello, and thanks for replying!

No, the elbows cannot be uniform for all sizes... they must follow the size of pipe..

I have another lisp that worked in 2002 autocad but not now...

Can we modify this????

(defun C:DOLI(/ dol)
(if (not dolim) (setq dolim 0))
(setq dol (getreal (strcat "\nEnter the lower limit of diameter in inches<"
(rtos dolim 2 2) ">: ")))
(if dol (setq dolim dol))
(princ)
)

(defun marc(ptlst / rf s e e2 e3 e4)
(setq s 0)
(if (> (length ptls) 2)
(repeat (- (length ptls) 2)
(setq e (nth s ptlst) e2 (nth (1+ s) ptlst)
e3 (nth (setq s (+ s 2)) ptlst) e4 (nth (1+ s) ptlst)
)
(if (inters e e2 e3 e4) (setq rf (- r ri)) (setq rf (+ r ri)))
(setq e (mapcar '+ e e2) e (mapcar '/ e '(2 2))
e2 (mapcar '+ e3 e4) e2 (mapcar '/ e2 '(2 2)))
(command
"fillet" "r" rf
"fillet" e e2
)
)
)
)

(defun C:PIPE(/ e e2 e3 s ptls ptls1 ptls2 dn r ri an an1 an2 dels dnls)
(setvar "CMDECHO" 0)
(setq dels '(21 26 33 42 48 60 73 89 114 141 168 219 273 324)
dnls '(0.5 0.75 1 1.25 1.5 2 2.5 3 4 5 6 8 10 12)
dn (getdist "\nEnter the nominal diameter in inches: ")
r (* 38.1 dn)
s t e t ptls '() ptls2 '()
)
(if (> dn dolim) (slay "P2_CENTER") (slay "P5_PIPE"))
(while e
(if s
(progn
(setq e (getpoint "\nFrom point: "))
(command "line" e)
(setq s nil)
)
(progn
(setq e (getpoint e "\nTo point: "))
(command e)
)
)
(setq ptls (cons e ptls))
)
(setq ptls (reverse (cdr ptls)))
(command "fillet" "r" r)
(setq s 0)
(if (> (length ptls) 2)
(repeat (- (length ptls) 2)
(setq e (nth s ptls) e2 (nth (+ s 1) ptls) e3 (nth (+ s 2) ptls)
an1 (angle e2 e) an2 (angle e2 e3)
an (/ (abs (- an1 an2)) 2.0)
)
(if (> an pi2) (setq an (- pi an)))
(setq an (* (/ (cos an) (sin an)) r)
ptls2 (append ptls2
(list (polar e2 an1 an) an1 (polar e2 an2 an) an2)
)
e (mapcar '+ e e2) e (mapcar '/ e '(2 2))
e2 (mapcar '+ e2 e3) e2 (mapcar '/ e2 '(2 2))
s (1+ s)
)
(command "fillet" e e2)
)
)
(if (> dn dolim)
(progn
(setq s 0 ri nil)
(while (and (not ri) (<= s (length dnls)))
(if (= dn (nth s dnls)) (setq ri (/ (nth s dels) 2.0)) (setq s (1+ s)))
)
(if (not ri) (setq ri (* 12.7 dn)))
(command "layer" "s" "P5_PIPE" "")
(setq an pi2)
(repeat 2
(setq ptls1 '() s 0)
(repeat (1- (length ptls))
(setq e (nth s ptls) e2 (nth (1+ s) ptls) e3 (+ (angle e e2) an)
e (polar e e3 ri) e2 (polar e2 e3 ri)
ptls1 (append ptls1 (list e e2))
)
(command "line" e e2 "")
(setq s (1+ s))
)
(marc ptls1)
(setq an (- an))
)
)
)
(setq s 0)
(if (> (length ptls) 2)
(if (> dn dolim)
(repeat (/ (length ptls2) 2)
(setq e (nth s ptls2) an (nth (1+ s) ptls2) s (+ s 2))
(command "line" (polar e (+ an pi2) ri) (polar e (- an pi2) ri) "")
)
(progn
(command "donut" 0 (* 0.5 sc))
(repeat (/ (length ptls2) 2)
(setq e (nth s ptls2) s (+ s 2))
(command e)
)
(command "")
)
)
)
(setq ptls nil ptls1 nil ptls2 nil)
(setvar "BLIPMODE" 0)
(princ)
)

(defun C:PIPEND (/ pt1 pt2 pt3 pt4 angl ds)
(setvar "cmdecho" 0)
(slay "P5_PIPE")
(sline "\nSelect the first line: ")
(if (> (distance p p1) (distance p p2)) (setq pt1 p2) (setq pt1 p1))
(sline "\nSelect the second line:")
(if (> (distance p p1) (distance p p2))
(setq pt2 p2 pt4 p1) (setq pt2 p1 pt4 p2)
)
(setq angl (angle pt1 pt2)
ds (distance pt1 pt2)
pt3 (polar pt1 angl (/ ds 2))
pt4 (polar (polar pt3 angl (/ ds 4)) (angle pt2 pt4) (/ ds 8))
)
(command
"ellipse" pt1 pt3 (/ ds 8)
"copy" "l" "" pt1 pt3
"break" "l" pt2 pt4
"erase" pt4 ""
)
)

[ronjonp]

Take a look at THIS thread. Many examples of creating pipes with radius corners.