make transitions @15degrees for dpipe lisp

[chelsea1307]

I got this lisp off of cadtutor it was written by ASMI. Is there a way to edit it to make transitions from one pipe size to another at 15 degrees?

CREATES DOUBLE LINE DUCT WITH CAPS AND CORNERS, NO TRANSITIONS
(defun c:dpipe(/ 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 <" (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))
     (progn
      (setq ang1
      (+(/ pi 2)(angle(caar segLst)(caadr segLst)))
     ang2
      (+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst))))
     ); end setq
      ); end progn
     ); 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(SideCalculate(cadar segLst)ang3)))); end setq
     ); end if
     (if(and ang1 ang2)
     (progn
     (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))
       (< 2(length segLst))
     ); end and
     (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
    (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:dpipeAttached Images
  
--------------------------------------------------------------------------------
Last edited by ASMI : 24th Feb 2007 at 07:29 am. Reason: Fixed small bug  

[MarcoW]

Hi Chelsea1307,

 

What do you mean by transition @ 15 degrees?

You might wanna search this forum for the wpipe.lsp routines.

There are some versions of it in this forum.

 

Some of them work fine for me. Try 'em i'd say...

[mdbdesign]

Try to read command line:

 

DPIPE

Specify first segment width :

 

Specify start point: _.pline

Specify start point:

Current line-width is 2.0000

Specify next point or [Arc/Halfwidth/Length/Undo/Width]:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: w

 

Specify starting width :

 

Specify ending width : 1.5

 

Calculate what you need to get degree and length.

[chelsea1307]

I want the change from one to the other to be at the same degree all the time, whether it happens in 3 inches or 3 feet doesnt matter as long as it progresses at 15 degrees ive attached an image to show what im talking about. Other then that the lisp works great for double line duct drawing ive looked at the other ones posted on this site and this one works the best for me except for that.