Need better multiline

January 6, 2007

Got any good beginner tutorials around here? I'm not a stranger to programming, I know Visual Basic, some Java, C concepts, PHP, so I should be able to jump right in.

Free time is the problem for me too. When I have some, I'll look into it. In the mean time, you can check this:

http://www.afralisp.net/

January 6, 2007

>Vigilante

Now pipes is multilines and coners is closed polylines. But change widths within the command while unavailable. It so is important? Possible to repeat a command with new width? It's possible but I had small time to do it.

(defun c:dpipe(/ oldWd oldFil oldEch lEnt actDoc segLst
              pl1 pl2 pl3 pl4 vLst1 vLst2 stLst oldWid
       peSet curPl delFlg *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 . "BYLAYER")
   '(49 . -0.5)'(62 . 256)'(6 . "BYLAYER"))); 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)
   (if delFlg
     (command "_.erase"(entlast)"")
     ); end if
   (if(and oldEch oldFil)
     (progn
   (setvar "CMDECHO" oldEch)
   (setvar "FILLMODE" oldFil)
   (setvar "PLINEWID" oldWid)
     ); end progn
    ); end if
    (if actDoc
     (vla-EndUndoMark actDoc)
     ); end if
   (princ)
   ); end of *error*

 (PipeMLineStyle)
 
 (if(not duct:pWd)(setq duct:pWd 1.0))
 (setq oldWd duct:pWd
duct:pWd(getdist
    	          (strcat "\nSpecify pipe diameter <" (rtos duct:pWd) ">: "))
oldFil(getvar "FILLMODE")
oldEch(getvar "CMDECHO")
oldWid(getvar "PLINEWID")
); end setq
 (if(null duct:pWd)(setq duct:pWd oldWd))
 (mapcar 'setvar
   '("CMDECHO" "FILLMODE") '(0 0))
 (if(entlast)(setq lEnt(entlast)))
 (vla-StartUndoMark
  (setq actDoc
   (vla-get-ActiveDocument
     (vlax-get-acad-object))))
 (princ "\nSpecify start point: ")
 (command "_.pline" pause)
 (command "_w" duct:pWd duct:pWd)
 (while(= 1(getvar "CMDACTIVE"))
   (command pause)
   (setq delFlg T)
   (princ "\nSpecify next point or [Length/Undo]: ")
   ); end while
 (if
   (not
     (equal lEnt(entlast)))
(progn
 (setq lEnt(entlast)
       stLst(asmi-LayersUnlock))
 (command "_.fillet" "_r" duct:pWd)
 (command "_.fillet" "_p" lEnt)
 (setq segLst
 (asmi-PlineSegmentDataList lEnt)
); end setq
 (while(/= 1(length segLst))
   (if(= 0.0(last(car segLst)))
     (progn
(command "_.mline"
                "_ST" "DUCT_PIPE"
                "_S" duct:pWd
                "_J" "_Z"
        (caar segLst)(caadr segLst) ""); end command
); end progn
     (progn
(command "_.pline" (caar segLst)(caadr segLst) "")
(setq curPl
       (vlax-ename->vla-object
	 (entlast)))
(vla-put-ConstantWidth curPl 0.0)
(vla-SetBulge curPl 0 (last(car segLst)))
(setq pl1
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(/ duct:pWd 2)))))
      pl2
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(-(/ duct:pWd 2))))))
      vLst1
       (GetPlineVer
	 (vlax-vla-object->ename pl1))
      vLst2
       (GetPlineVer
	 (vlax-vla-object->ename pl2))
      ); end setq
(setvar "PLINEWID" 0.0)
(command "_.pline"(car vLst1)(car vLst2) "")
(setq pl3(entlast))
(command "_.pline"(last vLst1)(last vLst2) "")
(setq pl4(entlast))
(vla-Delete curPl)
(setq peSet(ssadd))
(ssadd(vlax-vla-object->ename pl1)peSet)
(ssadd(vlax-vla-object->ename pl2)peSet)
(ssadd pl3 peSet)(ssadd pl4 peSet)
       (command "_.pedit" "_m" peSet "" "_j" "0.0" "")
); end progn
     ); end if
   (setq segLst(cdr segLst))
   ); end while
 (command "_.erase" lEnt "")
 (asmi-LayersStateRestore stLst)
 ); end progn
   ); end if
 (vla-EndUndoMark actDoc)
 (setvar "CMDECHO" oldEch)
 (setvar "FILLMODE" oldFil)
 (setvar "PLINEWID" oldWid)
 (princ)
 ); end of c:dpipe

January 6, 2007

And transform multiple polylines to pipes. It seems more convinient at some cases.

(defun c:mpipe(/ oldWd oldFil oldEch lEnt actDoc segLst
              pl1 pl2 pl3 pl4 vLst1 vLst2 stLst oldWid
       peSet lnLst curPl lSet *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 . "BYLAYER")
   '(49 . -0.5)'(62 . 256)'(6 . "BYLAYER"))); 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)
   (if(and oldEch oldFil)
     (progn
   (setvar "CMDECHO" oldEch)
   (setvar "FILLMODE" oldFil)
   (setvar "PLINEWID" oldWid)
     ); end progn
    ); end if
    (if actDoc
     (vla-EndUndoMark actDoc)
     ); end if
   (princ)
   ); end of *error*

 (PipeMLineStyle)
 
 (if(not duct:pWd)(setq duct:pWd 1.0))
 (setq oldWd duct:pWd
duct:pWd(getdist
    	          (strcat "\nSpecify pipe diameter <" (rtos duct:pWd) ">: "))
oldFil(getvar "FILLMODE")
oldEch(getvar "CMDECHO")
oldWid(getvar "PLINEWID")
); end setq
 (if(null duct:pWd)(setq duct:pWd oldWd))
 (mapcar 'setvar
   '("CMDECHO" "FILLMODE") '(0 0))
 (if(entlast)(setq lEnt(entlast)))
 (vla-StartUndoMark
  (setq actDoc
   (vla-get-ActiveDocument
     (vlax-get-acad-object))))
 (princ "\n>>> Select polylines to transform to pipes <<< ")
  (if
   (setq lSet
     (ssget '((0 . "LWPOLYLINE"))))
(progn
 (setq lnLst(vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex lSet)))
       stLst(asmi-LayersUnlock))
 (foreach lEnt lnLst
 (command "_.fillet" "_r" duct:pWd)
 (command "_.fillet" "_p" lEnt)
 (setq segLst
 (asmi-PlineSegmentDataList lEnt)
); end setq
 (while(/= 1(length segLst))
   (if(= 0.0(last(car segLst)))
     (progn
(command "_.mline"
                "_ST" "DUCT_PIPE"
                "_S" duct:pWd
                "_J" "_Z"
        (caar segLst)(caadr segLst) ""); end command
); end progn
     (progn
(command "_.pline" (caar segLst)(caadr segLst) "")
(setq curPl
       (vlax-ename->vla-object
	 (entlast)))
(vla-put-ConstantWidth curPl 0.0)
(vla-SetBulge curPl 0 (last(car segLst)))
(setq pl1
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(/ duct:pWd 2)))))
      pl2
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(-(/ duct:pWd 2))))))
      vLst1
       (GetPlineVer
	 (vlax-vla-object->ename pl1))
      vLst2
       (GetPlineVer
	 (vlax-vla-object->ename pl2))
      ); end setq
(setvar "PLINEWID" 0.0)
(command "_.pline"(car vLst1)(car vLst2) "")
(setq pl3(entlast))
(command "_.pline"(last vLst1)(last vLst2) "")
(setq pl4(entlast))
(vla-Delete curPl)
(setq peSet(ssadd))
(ssadd(vlax-vla-object->ename pl1)peSet)
(ssadd(vlax-vla-object->ename pl2)peSet)
(ssadd pl3 peSet)(ssadd pl4 peSet)
       (command "_.pedit" "_m" peSet "" "_j" "0.0" "")
); end progn
     ); end if
   (setq segLst(cdr segLst))
   ); end while
 (command "_.erase" lEnt "")
   ); end foreach
 (asmi-LayersStateRestore stLst)
 ); end progn
   ); end if
 (vla-EndUndoMark actDoc)
 (setvar "CMDECHO" oldEch)
 (setvar "FILLMODE" oldFil)
 (setvar "PLINEWID" oldWid)
 (princ)
 ); end of c:mpipe

January 7, 2007

Hi.

Nice lisp, ASMI. ¡Thank you!

See you.

January 8, 2007

Attention. To function c:dpipe are made some changes. Namely removal of a polyline after pressing Esc button.

>jademar

Thank you.

January 8, 2007

>Vigilante

Now pipes is multilines and coners is closed polylines. But change widths within the command while unavailable. It so is important? Possible to repeat a command with new width? It's possible but I had small time to do it.

(defun c:dpipe(/ oldWd oldFil oldEch lEnt actDoc segLst
              pl1 pl2 pl3 pl4 vLst1 vLst2 stLst oldWid
       peSet curPl delFlg *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 . "BYLAYER")
   '(49 . -0.5)'(62 . 256)'(6 . "BYLAYER"))); 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)
   (if delFlg
     (command "_.erase"(entlast)"")
     ); end if
   (if(and oldEch oldFil)
     (progn
   (setvar "CMDECHO" oldEch)
   (setvar "FILLMODE" oldFil)
   (setvar "PLINEWID" oldWid)
     ); end progn
    ); end if
    (if actDoc
     (vla-EndUndoMark actDoc)
     ); end if
   (princ)
   ); end of *error*

 (PipeMLineStyle)
 
 (if(not duct:pWd)(setq duct:pWd 1.0))
 (setq oldWd duct:pWd
duct:pWd(getdist
    	          (strcat "\nSpecify pipe diameter <" (rtos duct:pWd) ">: "))
oldFil(getvar "FILLMODE")
oldEch(getvar "CMDECHO")
oldWid(getvar "PLINEWID")
); end setq
 (if(null duct:pWd)(setq duct:pWd oldWd))
 (mapcar 'setvar
   '("CMDECHO" "FILLMODE") '(0 0))
 (if(entlast)(setq lEnt(entlast)))
 (vla-StartUndoMark
  (setq actDoc
   (vla-get-ActiveDocument
     (vlax-get-acad-object))))
 (princ "\nSpecify start point: ")
 (command "_.pline" pause)
 (command "_w" duct:pWd duct:pWd)
 (while(= 1(getvar "CMDACTIVE"))
   (command pause)
   (setq delFlg T)
   (princ "\nSpecify next point or [Length/Undo]: ")
   ); end while
 (if
   (not
     (equal lEnt(entlast)))
(progn
 (setq lEnt(entlast)
       stLst(asmi-LayersUnlock))
 (command "_.fillet" "_r" duct:pWd)
 (command "_.fillet" "_p" lEnt)
 (setq segLst
 (asmi-PlineSegmentDataList lEnt)
); end setq
 (while(/= 1(length segLst))
   (if(= 0.0(last(car segLst)))
     (progn
(command "_.mline"
                "_ST" "DUCT_PIPE"
                "_S" duct:pWd
                "_J" "_Z"
        (caar segLst)(caadr segLst) ""); end command
); end progn
     (progn
(command "_.pline" (caar segLst)(caadr segLst) "")
(setq curPl
       (vlax-ename->vla-object
	 (entlast)))
(vla-put-ConstantWidth curPl 0.0)
(vla-SetBulge curPl 0 (last(car segLst)))
(setq pl1
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(/ duct:pWd 2)))))
      pl2
       (car
	 (vlax-safearray->list
	   (vlax-variant-value
	     (vla-Offset curPl(-(/ duct:pWd 2))))))
      vLst1
       (GetPlineVer
	 (vlax-vla-object->ename pl1))
      vLst2
       (GetPlineVer
	 (vlax-vla-object->ename pl2))
      ); end setq
(setvar "PLINEWID" 0.0)
(command "_.pline"(car vLst1)(car vLst2) "")
(setq pl3(entlast))
(command "_.pline"(last vLst1)(last vLst2) "")
(setq pl4(entlast))
(vla-Delete curPl)
(setq peSet(ssadd))
(ssadd(vlax-vla-object->ename pl1)peSet)
(ssadd(vlax-vla-object->ename pl2)peSet)
(ssadd pl3 peSet)(ssadd pl4 peSet)
       (command "_.pedit" "_m" peSet "" "_j" "0.0" "")
); end progn
     ); end if
   (setq segLst(cdr segLst))
   ); end while
 (command "_.erase" lEnt "")
 (asmi-LayersStateRestore stLst)
 ); end progn
   ); end if
 (vla-EndUndoMark actDoc)
 (setvar "CMDECHO" oldEch)
 (setvar "FILLMODE" oldFil)
 (setvar "PLINEWID" oldWid)
 (princ)
 ); end of c:dpipe

Hi ASMI, the script is looking good.

Yes I can always start a new command with a new width. But that is what I use mline for now anyway. I'm trying to save time. So changing width inside a single command would save a lot of time.

Thanks for doing this!

January 8, 2007

>Vigilante

In some drawings is problem with "flying" coner polylines to 0,0 coordinates. I work to fix it and adding wide change inside command.

January 8, 2007

Vigilante, are you doing Ductwork?? or something similar that has transitions?

if so then ASMI, this is what he's wanting.... say you pick a "pipe" or "duct" that is 12" wide. well, within the command you have written, (assuming of course) he is wanting to choose a different size, bigger or smaller. so from 12" to 8", there will be a gap between the two sizes, connecting the plines together and showing caps. basically, it will transition to a new size all in one routine, on the fly. attached is an image to help clarify.

January 8, 2007

Oh and thanks for the link, Paul. I need to start learning this stuff. I'd like to merge some features of both yours and ASMI's script.

I'd like to eventually have a multiline command for drawing our ducts so there is basically no after-work to do. That would be more than awesome!

January 8, 2007

Ya, that is pretty much it, it's air duct.

I've attached a couple images to show kind of what ours looks like, and what I'd like my dream command to do.

duct.jpg is an image of what I'd like the command to be able to do in one fell swoop.

duct2.jpg is an example of a job I recently did.

Now imagine how much time could be saved on that job if I had a faster way! Imagine that I had to draw every arc manually, and every transition. That is a lot of exploding, trimming, drawing, stretching, texting, capping, and more!

Just by giving me rounded corners, you have saved a lot of time!

January 8, 2007

Vig... i work at a commercial HVAC mechanical company so we draw the same things.

if ASMI wants to basically write the whole program for you, then hats off. however, there are definitely alternatives. for instance, you can go to www.caelink.com and check out their HVAC package that your company can buy that does everything on the fly, or start utilizing Blocks for your vained 90's with the MLINE command. ASMI has already done what's needed for the radius 90s. really the only thing i have to do is add my transitions, which isn't hard at all if you use the OTRACK option from Midpoint of the last drawn duct.

also, with Tool Palettes, you can add ASMI's Lisp routine as a button. then copy/paste it many times, renaming and using Macro's to resize the "duct" so you don't always have to draw it.

for instance: i have utilized ASMI's lisp on a Tool Palette.

next, i copied/pasted each one, going to the properties and changing the Lisp using Macro so all i have to do is select which size i need. if you look under the 'Command String' i have renamed ASMI's Lisp to "db" instead of "duct" for my own personal custom keyboard command. so when i select the icon, it starts the Lisp. Then, using Macros, i use ";" = enter, and then i type the offset, and bam - instant duct sizes at the click of a button all within 10 minutes of setting up and planning ahead.

ASMI's Lisp does the rest, except transitions, but it's really easy when you Offset the next ductsize by using OTRACK from the midpoint of the endcap. just PLINE the three points after you're done with the entire duct trunkline.

January 9, 2007

>Vigilante, StykFacE

Hi. I can do, what you ask me. But I have much work at this time. My cheef goes behind my back and see how I work . But I find some time at this week to end this lisp.

January 9, 2007

well, i'm perfectly fine with what you have done already. of course it would be awesome to have a completed Lisp routine that fit's our exact job needs.... that is completely up to you. i'm in the process of learning Lisp myself, i know VERY basic things.

i just really appreciate your work so far. i have already been much more efficient at the office with it, especially on radius ductwork.

January 9, 2007

Yes, excellent so far!

Thanks for the suggestions StykFacE. I've always been faster just wacking shortcuts out then trying to use menus and blocks and scripts and so forth. But I'll give it a shot with the macros and see what happens.

Cheers!

January 10, 2007

well trust me, i'm ALL ABOUT the keyboard. i HAAAAAATE seeing people use nothing but the toolbars, but in this case it's actually faster. for instance, i have my MLSTYLEs saved as a block so when i import them in i have to type: ML Enter, STyle Enter, ## Enter, then draw the duct. better just to click a button and voila - done.

same with the Lisp. it's just better in my case.

January 24, 2007

Now pipes is multilines and coners is closed polylines. But change widths within the command while unavailable. It so is important? Possible to repeat a command with new width? It's possible but I had small time to do it.

Hi ASMI, yes I would still like to change widths in the command, this would be the ultimate feature!

Just checking in.

Thanks again!

January 24, 2007

Yes I remember. I shall be engaged in it today. I all time on what that distract and for it there is no time to finish. It is necessary to be more concentrated... and to not distract on writing other programs.

January 24, 2007

Thank you for doing this, I am sure the finished script will be most useful to anybody who has to draw air duct like this!

January 27, 2007

At last the trial variant is ready. It demands additional check. It works as drawing of a usual polyline with various width of segments, option Arc does not work.

Draw duct pipes:

(defun c:dpipe(/ 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

Unfortunately not always it is possible to receive enough time and silence to concentrate and program.

January 27, 2007

And transform polylines to duct pipes:

(defun c:mpipe(/ actDoc Ang1 Ang2 enDist stDist lEnt
       lObj lPln oldVars oldWd plEnd plLst
       plSet plStart1 plStart2 prDir ptLst
       segLst Start stLst tAng vlaPln)
 
 (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)
   (if oldVars
     (mapcar 'setvar
     '("CMDECHO" "OSMODE" "PLINEWID")
     oldVars); end mapcar
    ); end if
   (if stLst
     (asmi-LayersStateRestore stLst)
     ); end if
    (if actDoc
     (vla-EndUndoMark actDoc)
     ); end if
   (princ)
   ); end of *error*

 (PipeMLineStyle)
 
(if(not mpipepWd)(setq mpipepWd 1.0))
  (setq oldWd mpipepWd
               mpipepWd(getdist
                         (strcat "\nSpecify duct pipe width <" (rtos mpipepWd) ">: "))
 ); end setq
(if(null mpipepWd)(setq mpipepWd oldWd))

 (vla-StartUndoMark
  (setq actDoc
   (vla-get-ActiveDocument
     (vlax-get-acad-object))))
 (setq oldVars(mapcar 'getvar '("CMDECHO" "OSMODE" "PLINEWID")))
(princ "\n>>> Select polylines to transform to duct pipes <<< ")

 (setq plSet
 (ssget '((0 . "LWPOLYLINE")))); end setq
 (if plSet
   (progn
(setq stLst(asmi-LayersUnlock)
 	      plLst(vl-remove-if 'listp 
                (mapcar 'cadr(ssnamex plSet)))
 ); end setq
 (setvar "OSMODE" 0)
 (setvar "CMDECHO" 0)
 (foreach pl plLst
   (setq segLst
   (asmi-PlineSegmentDataList pl)
  vlaPln(vlax-ename->vla-object pl)
  ); end setq
 (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 mpipepWd))); 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 mpipepWd))
	prDir nil); end setq
     ); end if
   (if
     (< 2(length segLst))
      (setq plStart2
       (vlax-curve-getPointAtDist vlaPln
	 (+ enDist mpipepWd))
     ptLst
                    (mapcar
	      '(lambda(x)(trans x 0 1)); end lambda
                (list(polar plEnd ang1 (/ mpipepWd 2))
		(polar plEnd (+ pi ang1)(/ mpipepWd 2))
		(polar plStart2 (+ pi ang2)(/ mpipepWd 2))
		(polar plStart2 ang2 (/ mpipepWd 2))
	      	); end list
	    ); end mapcar
	); end setq
 ); 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
   (not(equal ang1 ang2 0.000001))
      		(progn
	       	(setvar "PLINEWID" 0.0)
	       	(command "_.pline")
		(mapcar 'command ptLst)(command "_c")
	       	(setvar "PLINEWID" mpipepWd)
 	); 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

   	 (command "_.mline" "_st" "DUCT_PIPE"
	"_S" mpipepWd "_J" "_Z"
	plStart1 plEnd "")
   
   (setq segLst(cdr segLst)); end setq
   ); end while
   (vla-Delete vlaPln)
   ); end foreach
     (vla-EndUndoMark actDoc)
     (asmi-LayersStateRestore stLst)
      ); end progn
     ); end if
(mapcar 'setvar
     '("CMDECHO" "OSMODE" "PLINEWID")
     oldVars); end apply
 (princ)
 ); end of c:mpipe

Need better multiline

Recommended Posts

paulmcz

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ASMI

ASMI

Ronso

Posted Images

ASMI

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

jademar

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

tzframpton

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

tzframpton

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

tzframpton

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

tzframpton

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

Vigilante

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

ASMI

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity