Need better multiline

[dharmendra prajapati]

On 1/5/2007 at 3:38 AM, ASMI said:

It seems good idea to me has come. It is possible to transform existing polylines to pipes.

 

 

(defun c:plp(/ lSet plLst pl pl1 pl2 oldOsm
      actDoc vLst1 vLst2 stLst *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-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

 (if(not duct:pWd)(setq duct:pWd 1.0))
 (setq oldWd duct:pWd
duct:pWd(getdist
     (strcat "\nSpecify pipes diameter <" (rtos duct:pWd) ">: "))
); end setq
 (if(null duct:pWd)(setq duct:pWd oldWd))
(princ "\n>>> Select polylines <<< ")
 (if
   (setq lSet
   (ssget '((0 . "LWPOLYLINE"))))
(progn
  (setq stLst(asmi-LayersUnlock)
	plLst(mapcar 'vlax-ename->vla-object
	       (vl-remove-if 'listp 
                        (mapcar 'cadr(ssnamex lSet))))
	); end setq
  (vla-StartUndoMark
    (setq actDoc
	   (vla-get-ActiveDocument
		  (vlax-get-acad-object))))
  (foreach pl plLst
  (command "_.fillet" "_r" duct:pWd)
  (command "_.fillet" "_p"
	   (vlax-vla-object->ename pl))
  (setq pl1(car(vlax-safearray->list
	     (vlax-variant-value
	       (vla-Offset pl (/ duct:pWd 2)))))
	pl2(car(vlax-safearray->list
	     (vlax-variant-value
	       (vla-Offset pl (-(/ duct:pWd 2))))))
	vLst1(GetPlineVer
	       (vlax-vla-object->ename pl1))
	vLst2(GetPlineVer
	       (vlax-vla-object->ename pl2))
	); end setq
  (vla-put-ConstantWidth pl1 0.0)
  (vla-put-ConstantWidth pl2 0.0)
  (vla-Delete pl)
  (foreach itm vLst1
    (setq oldOsm(getvar "OSMODE"))
    (setvar "OSMODE" 0)
    (command "._line" itm (car vLst2) "")
    (setvar "OSMODE" oldOsm)
    (setq vLst2(cdr vLst2))
    ); end foreach
    (asmi-LayersStateRestore stLst)
   ); end foreach
  (vla-EndUndoMark actDoc)
  ); end progn
   ); end if
 (princ)
 ); end of c:plp

 

 

 

On 1/5/2007 at 3:38 AM, ASMI said:

It seems good idea to me has come. It is possible to transform existing polylines to pipes.

 

 

(defun c:plp(/ lSet plLst pl pl1 pl2 oldOsm
      actDoc vLst1 vLst2 stLst *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-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

 (if(not duct:pWd)(setq duct:pWd 1.0))
 (setq oldWd duct:pWd
duct:pWd(getdist
     (strcat "\nSpecify pipes diameter <" (rtos duct:pWd) ">: "))
); end setq
 (if(null duct:pWd)(setq duct:pWd oldWd))
(princ "\n>>> Select polylines <<< ")
 (if
   (setq lSet
   (ssget '((0 . "LWPOLYLINE"))))
(progn
  (setq stLst(asmi-LayersUnlock)
	plLst(mapcar 'vlax-ename->vla-object
	       (vl-remove-if 'listp 
                        (mapcar 'cadr(ssnamex lSet))))
	); end setq
  (vla-StartUndoMark
    (setq actDoc
	   (vla-get-ActiveDocument
		  (vlax-get-acad-object))))
  (foreach pl plLst
  (command "_.fillet" "_r" duct:pWd)
  (command "_.fillet" "_p"
	   (vlax-vla-object->ename pl))
  (setq pl1(car(vlax-safearray->list
	     (vlax-variant-value
	       (vla-Offset pl (/ duct:pWd 2)))))
	pl2(car(vlax-safearray->list
	     (vlax-variant-value
	       (vla-Offset pl (-(/ duct:pWd 2))))))
	vLst1(GetPlineVer
	       (vlax-vla-object->ename pl1))
	vLst2(GetPlineVer
	       (vlax-vla-object->ename pl2))
	); end setq
  (vla-put-ConstantWidth pl1 0.0)
  (vla-put-ConstantWidth pl2 0.0)
  (vla-Delete pl)
  (foreach itm vLst1
    (setq oldOsm(getvar "OSMODE"))
    (setvar "OSMODE" 0)
    (command "._line" itm (car vLst2) "")
    (setvar "OSMODE" oldOsm)
    (setq vLst2(cdr vLst2))
    ); end foreach
    (asmi-LayersStateRestore stLst)
   ); end foreach
  (vla-EndUndoMark actDoc)
  ); end progn
   ); end if
 (princ)
 ); end of c:plp

 

 

can you do this with 3 polyline central from pipe , Please.

[BIGAL]

Yes is the answer.

 

Search for duct lisps. Plenty out there most work just that way draw centre then offset.

[DerekN]

Good Morning Forum,

 

I know this is very late asking but I have only recently downloaded the modified lisp WPipe[12] by Ronso but when I type duct, pipe or tray in to the command line after loading the lisp non of these commands are calling on the lisp. The message I am getting is unknown command. Can anyone help me with this?

[Lee Mac]

Assuming you are referring to the code attached to this post, the command for the program is 'wpipe'.

[whosa]

On 2/24/2007 at 2:53 PM, ASMI said:

I have executed some wishes of Vigilante. Now it is possible to not enter width each time and a pipe remains by pressing Esc.

 

 

(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 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 . 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 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(< 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
   ); end of Body Function

   (defun *error*(msg)
   (BodyFunction)
   (if oldVars
     (mapcar 'setvar
     '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
     oldVars); end mapcar
    ); end if
    (if actDoc
     (vla-EndUndoMark actDoc)
     ); end if
   (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))))
 (initget 128)
 (while(not cFlg)
  (setq fPt
 (getpoint
   (strcat
     "\nSpecify start point or width <"
     (rtos dpipepWd) ">: " ))); 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
 (BodyFunction)
 (vla-EndUndoMark actDoc)
(mapcar 'setvar
     '("FILLMODE" "PLINEWID" "CMDECHO" "OSMODE")
     oldVars); end apply
 (princ)
 ); end of c:dpipe

 

 

 

Hi Asmi,

 

This LISP works very well.

 

I am unable to make it work on left/right views (with UCS View), as it makes a double offset without filleting. 

 

Is it possible to add this feature?

 

Thanks

 

Edited October 1, 2022 by whosa