double line flex lisp

[TimSpangler]

Dave,

 

I just saw your posting. Give a bit and I'll have something for you.

 

TIM

[TimSpangler]

Dave,

 

Try this and see if it will do.

 

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;    WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;    PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;;    PROGRAMMER.
;;;
;;; -----------------------------------------------------------------------
;;; ------------ COMMAND LINE FUNCTIONS
(defun c:FLEX (/)(FLEX_START))
;;; ------------ MAIN FUNCTION
(defun FLEX_START (/ *error* OldCmdEcho OldOrthoMode OldOsmode OldLunits OldLunits OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine BlockName FlexEnd)

;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)         
 (if (not (member MSG '("Function cancelled" "quit / exit abort")))
  (princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
  (princ "\n... Program Cancelled ...")
 )
 (while (< 0 (getvar "cmdactive"))
  (command)
 )
 (FLEX_RESET_ENV)
)
;;; End Error Handler ---------------------------------------------------
(FLEX_SET_ENV)
)
;;; ------------ SETUP FLEXDUCT ENVIRONMENT SUB
(defun FLEX_SET_ENV (/)

;; Set sysetm variable
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOrthoMode (getvar "ORTHOMODE"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setq OldFillMode (getvar "FILLMODE"))
(setvar "CMDECHO" 0)

;; Set undo marker
(command "undo" "Begin")

(setvar "ORTHOMODE" 0)
(setvar "OSMODE" 514)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setvar "FILLMODE" 0)

;; Load VLISP funtionality
(vl-load-com)

;; Set Vlisp Environment variables
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
 (if (= (getvar "cvport") 1)
  (vla-get-paperspace ActiveDoc)
  (vla-get-modelspace ActiveDoc)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexDuct5Pts FlexCap1 FlexCap2 CloseOpt)

(if (not (setq FlexSize (getreal "\n Enter flex size: <6\"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)

(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))

(command "_pline" FlexStart "width" FlexSize FlexSize FlexEnd "arc")
(while (> (getvar "cmdactive") 0)
 (command PAUSE)
) 

(setq PlineEnt (entget(entlast)))
(setq VLPlineObj (vlax-ename->vla-object (cdr(assoc -1 PlineEnt))))
(setq VLPlineLength (fix (vlax-get VLPlineObj 'length)))

;; Change width to 0  (all for astetics)
(vlax-put VLPlineObj 'ConstantWidth 0.0) 
(setvar "FILLMODE" OldFillMode)

;; Add "flex" to duct
(command "divide" (entlast) "block" BlockName "y" VLPlineLength)

;; Create flex duct sides
(setq FlexDuct1 (car (vlax-invoke VLPlineObj 'offset (/ FlexSize 2))))
(setq FlexDuct2 (car (vlax-invoke VLPlineObj 'offset (-(/ FlexSize 2)FlexSize))))
;; Get the end points of the sides
(setq FlexDuct1Pts (vlax-curve-getEndPoint FlexDuct1))
(setq FlexDuct2Pts (vlax-curve-getEndPoint FlexDuct2))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))

(setq FlexDuct5Pts (vlax-curve-getEndPoint VLPlineObj))

;; Create caps
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))

;; Change the linetype to zizag
[color=red](vlax-put FlexDuct1 'Linetype "zigzag");<--change to your linetype[/color]
[color=red](vlax-put FlexDuct2 'Linetype "zigzag");<--change to your linetype[/color]


;; Check for losing option
(initget 1 "Blunt Arched")
(setq CloseOpt (getkword "\n Enter end condition: (Arched/Blunt)"))

(if (= "Blunt" CloseOpt)
 (setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
 (progn
  (vlax-invoke space 
  'addarc 
   FlexDuct5Pts 
   (/ FlexSize 2)
   (angle FlexDuct2Pts FlexDuct1Pts)
   (angle FlexDuct1Pts FlexDuct2Pts)
  )
 )
)
;; Delete centerline
(vla-delete VLPlineObj)

(FLEX_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun FLEX_BLOCK (FlexSize /)

(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)

(setq BlockName (strcat "FLEX-" (rtos FlexSize 5 2)))

(if (= (tblsearch "block" BlockName) nil) 
 (progn 
  (entmake
   (list
    (cons 0 "BLOCK")
    (cons 2 BlockName)
    (cons 70 64)
    (cons 10 (list 0.0 0.0 0.0))
    (cons 8 "0")
   )
  ) 
  (entmake
   (list
    (cons 0 "LINE")
    (cons 10 (list 0.0 (- (/ FlexSize 2) FlexSize) 0.0))
    (cons 11 (list 0.0 (/ FlexSize 2) 0.0))
    (cons 8 "0")
    (cons 62 9)
   )
  )
  (entmake
   '((0 . "ENDBLK"))
  ) 
 ) 
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)

;; Reset system variables
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)

;; Reset undo marker
(command "undo" "End")

(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

[d_kinneyjr]

Thanks Tim. It worked fine. Good routine!

[JONTHEPOPE]

Good Old Lisps

[deano33]

Hi Tim

 

Will The Flex Duct Lisp Routine Run In Autocad Lt Or Is There A Linetype I Can Use To Do The Same.

 

I Have Created A Linetype That Looks Similar To Flex And Scales To About 1 Mm Wide.

 

I Wrote A Beast Of A Menu Macro To Create A Spline Curve In The Flex Linetype And Can Input Flex Diameter By Linetype Scale But Could Be Better.

 

The Menu Macro Works Great But Looks Are Everything.

 

Any Help Here Will Be Great.

 

Many Thanks

 

Deano

[TimSpangler]

AtuoCADLT Does not support lisp out of the box. So to answer your question. No it will not work for you. It could be done with macro's but that would be one monster macro.

 

Sorry.

[randallphillips13]

Hey Tim,

 

Your lisp works great, you mentioned something about a HVAC suite. Do you have other related lips file you could share?

 

Randall

[TimSpangler]

Hey Tim,

 

Your lisp works great, you mentioned something about a HVAC suite. Do you have other related lips file you could share?

 

Randall

 

 

Yes. Give me a minute to get them together.

 

They are nothing special but they work.

 

BRB

[ASMI]

May be use LwPolyline?

 

(defun c:flx(/ oldWdt varLst oldVar plObj eDis
     cDis curAng plLst cWid *error*)
 (vl-load-com)

 (defun *error*(msg)
   (if oldVar(mapcar 'setvar varLst oldVar))
   (princ)
   ); end of *error*
 
 (if(not flex:width)(setq flex:width 6.0))
 (setq oldWdt flex:width
flex:width(getdist(strcat "\nSpecify flex width <"
		    (rtos flex:width 2 0) ">: "))
varLst(list "CMDECHO" "FILLMODE" "PLINEWID" "OSMODE")
oldVar(mapcar 'getvar varLst))
 (if(null flex:width)(setq flex:width oldWdt))
 (mapcar 'setvar varLst(list 0 1 flex:width 0))
 (princ "\nSpecify first point: ")
 (command "_.pline" pause "_arc")
 (while(= 1(getvar "CMDACTIVE"))
   (princ "\nSpcecify next point: ")(command pause))
 (setq plObj(vlax-ename->vla-object(entlast))
eDis(/ flex:width  cWid(/ flex:width 2) cDis 0.0)
 (while(setq cPnt(vlax-curve-GetPointAtDist plObj cDis))
   (setq cDer(vlax-curve-GetFirstDeriv plObj
	    (vlax-curve-GetParamAtPoint plObj cPnt))
         curAng(- pi(atan(/(car cDer)(cadr cDer)))))
   (if(< curAng pi)(setq curAng(- curAng pi)))   
   (setq plLst(cons(polar cPnt curAng(setq cWid(- cWid)))plLst)
         cDis(+ cDis eDis)))
 (vla-Delete plObj)(setvar "PLINEWID" 0.0)
 (command "_.pline")(mapcar 'command plLst)(command)
 (mapcar 'setvar varLst oldVar)
 (princ)
 ); end of c:flx

[TimSpangler]

Here is the "suite". It is still in a raw form but everything does work. It needs alot of refining but I haven't had the time to take to the next level. Fell free to use and abuse.

HVACSuite.zip

[CAB]

ASMI

another pline attempt.

http://www.cadtutor.net/forum/showpost.php?p=147076&postcount=5

[ASMI]

ASMI

another pline attempt.

http://www.cadtutor.net/forum/showpo...76&postcount=5

 

Nice tubes!

 

Here is the "suite". It is still in a raw form but everything does work. It needs alot of refining but I haven't had the time to take to the next level. Fell free to use and abuse.

 

So large set of routines. Thank you.

[randallphillips13]

Thanks Tim, I will take it for a test drive today!

 

Randall

[nmulder]

Tim,

 

I am a new addition to this forum. I downloaded your HVAC suite--it has a lot of useful things in it. Seems I have been doing HVAC drafting the hard way!

 

I've been able to modify your creatduct.lsp a little (like command text and duct layer names), but i can't get it to remove the centerline and insulation (our company very rarely displays this information graphically) without messing up the lisp routine/command. can you give me some pointers on modifying lisp routines?

 

also, i'd like to figure out how to change the text directives in the lisp to match our standards (font, size, etc.) but can't seem to do that either.

 

one last thing, how can i modify the orthomode settings. after using the creatduct lisp, both polar and ortho remain off. i usually use polar. this is less important than above.

 

anyway, thanks alot for all the lisps and help. you've already gotten me a lot further down the road!

 

nathan

[nocturne00]

Nice routine; just consenting to add it to my lisp library.

[lancer]

WOW!

 

Is TimSpangler a God?

 

Thank You!

[PJV]

I have joined the forum after searching for a routine to provide a good quality double line flex.

 

What an excellent routine this is, thanks Tim.

 

Just a slight problem, I need to draw in mm rather than inches. With my limited lisp experience I did manage to change the " to mm. This works fine the only prolem is the flex hatch spacings are fixed and based on imperial measurements they are that close together it turns the flex into almost a solid!

 

Any chance when you have a moment Tim to let me have the mod'

 

Many thanks

 

Peter

[barraganarq]

TIM

 

THESE LISP ROUTINES FROM THE HVAC SUITE ARE GREAT.

I AM JUST EXPERIENCING A PROBLEM WITH THE DIFFUSER ONE:

HERE IS WHAT I GET:

 

Command: DIFF

Enter diffuser style: (Supply/Return/Exhaust)S

Enter diffuser type: (Lay-In/Mounted)L

Enter diffuser Shape: (Square/Round)R

 

Enter diffuser diameter: (12")

Enter diffuser inlet size: (6")

Define insertion point:

*** Program Error: BAD FUNCTION: 426.469 ***

 

 

CAN YOU HELP ME GET THIS RUNNING?

THANKS A LOT

[TimSpangler]

Let me take a closer look at it.

[TimSpangler]

I can't seem to recreate the error. Post the file that you have so that I can compare it to the one that I have.

 

Thanks

 

TIM