Topic: Flex Duct Creator

[ljh19991220]

thanks   CAB   

[CAB]

You're quite welcome.

[Derek]

Is the reply #59 (CAB) with the point to point flex routine the latest and greatest one? Haven't been here for a while as the old flex routine works a treat, but I'm getting a bit sick of drawing in the centre line in.

[CAB]

Shame on you, you need to get here more often.

Yes it is the latest version. http://www.theswamp.org/index.php?topic=19272.msg383107#msg383107

[Derek]

Yes I've been bad....    

I have inserted the lisp again, but have this error.  [Pick end point of duct.; error: bad function: VLAX-CURVE-GETENDPARAM]

I had it working in a sense yesterday, although it did want to do the strange hookup as shown earlier in this thread. (how do I insert image? Insert image button doesn't seem to work for me)

Also- how do you define flex size with point to point? When I did have it going I was not prompted to enter a flex size like with the standard flex lisp.

One more - can this lisp be cut back so that it produces the centre line only? I would then use the flex routine to add flex later.

Thanks in advance CAB   

[Derek]

Ok I think I am sorting it out, I have to start flex command before flex2point works yes? I think however I have same issues in prevoius post with flex size etc. W continue to play around with it.

[Derek]

Code: [Select]

;;  Add Flex Duct by user picking 2 points on objects
;;  Objects must have curve properties to obtail perpendicular angle
(defun c:Flex2Point (/ acDoc Space pt p1 p2 p1a p2a ent sFlag dia ang ang2 pl flr)
  ;;  CAB test to see if vlax-curve can be used on an object
  (defun curveOK (ent)                  ; returns nil if not allowed
    (not (vl-catch-all-error-p
           (vl-catch-all-apply 'vlax-curve-getendparam (list ent))
         )
    )
  )

  ;;D. C. Broad, Jr.
  ;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>)
  (defun SideOf (p1 p2 p / r)
    (setq r
           (cond
             ((equal p1 p 1e-10) 0)
             (t (sin (- (angle p1 p) (angle p1 p2))))
           )
    )
    (if (equal r 0 1e-10) 0 r)
  )
  ;;return values
  ;;negative = point is to the right side of the ray
  ;;0 = point is on the ray
  ;;otherwise point is on the left side of the ray.
  ;;P1 should not equal P2 for meaningful results.

  ;;  by CAB 03/22/2009
  ;;  Expects pts to be a list of 2D or 3D points
  ;;  Returns new pline object
  (defun makePline (spc pts / norm elv pline)
    (setq norm (trans '(0 0 1) 1 0 T)
          elv  (caddr (trans (car pts) 1 norm))
    )
    (setq pline
           (vlax-invoke
             Spc
             'addLightWeightPolyline
             (apply 'append
                    (mapcar '(lambda (pt)
                               (setq pt (trans pt 1 norm))
                               (list (car pt) (cadr pt))
                             )
                            pts
                    )
             )
           )
    )
    (vla-put-Elevation pline elv)
    (vla-put-Normal pline (vlax-3d-point norm))
    pline
  )

  (defun GetNextPoint (pt pn ent dia / ang sFlag)
    (setq pt (vlax-curve-getclosestpointto ent pt))
    (setq ang (angle '(0 0)
                     (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt))
              )
    )
    (cond                               ; get perpendicular angle
      ((zerop (setq sFlag (Sideof pt (polar pt ang 10) pn)))
      )
      ((minusp sFlag)                   ; right side of the ray, CW= -90
       (setq ang (- ang (/ pi 2)))
      )
      ((setq ang (+ ang (/ pi 2))))     ; CCW=  +90
    )                                   ; cond
    (polar pt ang dia)
  )

  ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  (setq dia 12.)
  (initget "Diameter")
  (setq p1 (getpoint "\nPick start point of duct."))
  (setq p2 (getpoint p1 "\nPick end point of duct."))
  (if (and (setq ent (car (nentselp p1)))
           (curveOK ent)
      )
    (setq p1a (GetNextPoint p1 p2 ent dia))
    (setq p1a (polar p1 (angle p1 p2) dia))
  )
  (if (and (setq ent (car (nentselp p2)))
           (curveOK ent)
      )
    (setq p2a (GetNextPoint p2 p1 ent dia))
    (setq p2a (polar p2 (angle p2 p1) dia))
  )

  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq Space
         (if (= 1 (getvar "CVPORT"))
           (vla-get-PaperSpace AcDoc)
           (vla-get-ModelSpace AcDoc)
         )
  )

  (if (setq pl (makePline Space (list p1 p1a p2a p2)))
    (progn
      (setq flr (getvar "FILLETRAD"))
      (setq cmde (getvar "CmdEcho"))
      (setvar "CmdEcho" 0)
      (setvar "FILLETRAD" dia)
      (command "._fillet" "_P" (vlax-vla-object->ename pl))
      (setvar "FILLETRAD" flr)
      (setvar "CmdEcho" cmde)
      (c:Flex (vlax-vla-object->ename pl)
              '((DuctDiam 12)(FlexLayer "0")(FlexColor 1)))
    )
  )

  (princ)
)


;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler
;;; Contact or Updates  @  www.TheSwamp.org
;;; Version:  1.7   Feb. 21,2008
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;;    Centerline may be anything vla-curve will handle
;;; Sub_Routines:     
;;;    makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;;    Duct Layer is hard coded, see var Flexlayer
;;;    No error handler at this time
;;; Known Issues:
;;;    Tight curves cause pline jacket distortion
;;;    Added warning when this is about to occur
;;; Returns:  none
;;;=====================================================================
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED     ;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR  ;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.            ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice below appear in all supporting documentation.              ;
;;;=====================================================================

;;;  Modified by Lee Mac to force Centerline to specified layer.

(defun c:Flex (/         cl-ent    ribWidth  RibShort  RibLong   collar
               dist      steps     ribFlag   pt        curAng    curDer
               RibPtLst1 RibPtLst2 p1        p2        doc       space
               cflag     cl-len    ribRadius tmp       NewPline  NewPline2
               pl1       pl2       cnt       errflag   InsulThick   FlexColor
               FlexLayer ss        CentLayer  CentColor Centerobj
              )
  (vl-load-com)
  (setq Doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)

  ;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
 
  ;;  Change these if you want
 
  (setq FlexLayer "M_flex")   ; put your Duct layer here
  (setq CentLayer "M_centre")   ; Put your Centerline layer here
  (setq FlexColor 45)   ; put your color over ride here or acBylayer
  (setq CentColor acred)  ;; put your color override here or acByLayer
  (setq InsulThick 0)    ; to be added to duct diameter, use 2 for 1" insulation
  (setq collar 6.0)      ; collar length at each end
  (setq DelCL nil)       ; delete the centerline t=Yes nil=No
  (setq GroupFlex nil)     ; make flex duct a Group t=Yes nil=No
 
  ;; \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/


  ;;   --------   Local Functions   ---------

  ;;  Expects pts to be a list of 2D or 3D points
  (defun makePline (spc pts)
    (if (= (length (car pts)) 2) ; 2d point list
      (setq pts (apply 'append pts))
      (setq
        pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts))
      )
    )
    (setq
      pts (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
              pts
            )
          )
    )
    (vla-addlightweightpolyline spc pts)
  )
  ;;   -------------------------------------

  ; Lee Mac Mod {
 
  (mapcar
    (function
      (lambda (layer) (or (tblsearch "LAYER" layer)
                          (vla-add (vla-get-Layers doc) layer))))
   
    (list FlexLayer CentLayer))

  ; } End of Lee Mac Mod


  ;;  Get the Duct Diameter, global variable
  (or duct:dia (setq duct:dia 200.0)) ; default value

  (while            ; Main Loop
    (progn
      (prompt (strcat "\nDuct diameter is set to "
                      (vl-princ-to-string duct:dia)
              )
      )
      (setvar "errno" 0) ; must pre set the errno to 0
      (initget "Diameter")
      (setq cl-ent
             (entsel (strcat "\nSelect center line of flex duct.[Diameter]<"
                             (vl-princ-to-string duct:dia)
                             "> Enter to quit."))
      )

      (cond
        ((= (getvar "errno") 52) ; exit if user pressed ENTER
         nil        ; exit loop
        )
        ((= cl-ent "Diameter")
         (initget (+ 2 4))
         (setq
           tmp (getdist
                 (strcat "\nSpecify duct diameter <" (rtos duct:dia) ">: ")
               )
         )
         (and tmp (setq duct:dia tmp))
         t          ; stay in loop
        )

        ((not (null cl-ent))
         ;;  check entity before making the duct
         (if (not (vl-catch-all-error-p
                    (setq tmp (vl-catch-all-apply
                                'vlax-curve-getpointatparam
                                (list (car cl-ent) 0.0)
                              )
                    )
                  )
             )
           (progn   ; OK to make duct
             
             (setq cl-ent   (car cl-ent) ; Center Line
                   ribWidth (* duct:dia 0.167)
                   RibShort (+ duct:dia InsulThick) ; add insulation
                   RibLong  (+ RibShort (* ribWidth 0.8))
             )

             ;; Lee Mac Mod {

             (vla-put-layer
               (setq centerobj (vlax-ename->vla-object cl-ent)) CentLayer)

             (vla-put-color centerobj centcolor)

             ;; }  End of Lee Mac Mod

             ;;  centerline length
             (setq cl-len (vlax-curve-getdistatparam
                            cl-ent
                            (vlax-curve-getendparam cl-ent)
                          )
                   cl-len (- cl-len (* collar 2.0))
                   steps  (/ cl-len ribWidth)
             )
             (if (= (logand (fix steps) 1) 1) ; T = odd
               (setq steps (fix steps))
               (setq steps (1+ (fix steps)))
             )
             (setq ribWidth (/ (- cl-len 0.25) (1- steps))
                   dist     collar ;0.125 ; distance along center line
             )

           
             (setq ribFlag 0
                   cflag   t
                   cnt     0
                   pl1     nil
                   pl3     nil
                   errflag nil
             )

             ;;  ----------   Create Rib End Points   -----------
             (repeat steps
               (setq pt (vlax-curve-getpointatdist cl-ent dist))
               (setq
                 curDer (trans
                          (vlax-curve-getfirstderiv
                            cl-ent
                            (vlax-curve-getparamatpoint cl-ent pt)
                          )
                          0
                          1
                        )
               )
               ;; Get angle 90 deg to curve
               (setq curAng (+ (/ pi 2) (angle '(0 0) curDer)))
               (setq ribRadius (if (zerop ribFlag)
                                 (/ RibShort 2)
                                 (/ RibLong 2)
                               )
               )
               (setq pt (trans pt 0 1)) ; WCS > UCS
               (setq p1 (polar pt curAng ribRadius))
               (setq p2 (polar pt (+ pi curAng) ribRadius))
               (if cflag ; create start collar points
                 (setq RibPtLst1 (list (polar p1 (angle curDer '(0 0)) collar))
                       RibPtLst2 (list (polar p2 (angle curDer '(0 0)) collar))
                       cflag     nil
                 )
               )

               ;;  this collection method creates a woven pline
               (cond
                 ((null pl1) ; first time through
                  (setq RibPtLst1 (cons p1 RibPtLst1)
                        RibPtLst2 (cons p2 RibPtLst2)
                  )
                 )
                 ((= (logand (setq cnt (1+ cnt)) 1) 1) ; T = odd cnt
                  (setq RibPtLst1 (cons pl2 RibPtLst1)
                        RibPtLst1 (cons p2 RibPtLst1)
                        RibPtLst2 (cons pl1 RibPtLst2)
                        RibPtLst2 (cons p1 RibPtLst2)
                  )
                 )
                 ((setq RibPtLst1 (cons pl1 RibPtLst1)
                        RibPtLst1 (cons p1 RibPtLst1)
                        RibPtLst2 (cons pl2 RibPtLst2)
                        RibPtLst2 (cons p2 RibPtLst2)
                  )
                 )
               )
               (if (and pl3 (inters p1 p2 pl3 pl4 t))
                 (setq errflag t)
               )
               (setq ribFlag (- 1 ribFlag) ; toggle flag
                     dist    (+ ribWidth dist)
                     pl3     pl1
                     pl4     pl2
                     pl1     p1
                     pl2     p2
               )
             )
             ;;  create end collar points
             (setq RibPtLst1 (cons p2 RibPtLst1)
                   RibPtLst1 (cons (polar p2 (angle '(0 0) curDer) collar) RibPtLst1)
                   RibPtLst2 (cons p1 RibPtLst2)
                   RibPtLst2 (cons (polar p1 (angle '(0 0) curDer) collar) RibPtLst2)
             )

             ;;  --------   point list to WCS   ------------
             (setq RibPtLst1 (mapcar '(lambda (x) (trans x 1 0)) RibPtLst1))
             (setq RibPtLst2 (mapcar '(lambda (x) (trans x 1 0)) RibPtLst2))

             ;;  --------   create jacket plines   ------------
             (or space
                 (setq space
                        (if (zerop (vla-get-activespace doc))
                          (if (= (vla-get-mspace doc) :vlax-true)
                            (vla-get-modelspace doc) ; active VP
                            (vla-get-paperspace doc)
                          )
                          (vla-get-modelspace doc)
                        )
                 )
             )

             (cond
               ((and errflag
                     (progn
                       (initget "Yes No")
                       (= "No"
                          (cond
                            ((getkword "\nTurns too tight, Proceed? [Yes/No]<Yes>:"))
                            ("Yes")))
                       )
                     )
                t ; skip the create & stay in loop
               )
               ((setq newpline (makePline space RibPtLst1))
                (vla-put-layer newpline Flexlayer)
                (if FlexColor
                  (vla-put-color newpline FlexColor)
                )
                ;;(vla-put-elevation newpline z)

                (setq newpline2 (makePline space RibPtLst2))
                (vla-put-layer newpline2 Flexlayer)
                (if FlexColor
                  (vla-put-color newpline2 FlexColor)
                )
                ;;(vla-put-elevation newpline z)
               
                (if DelCL (entdel cl-ent)) ; remove the centerline object
                (if GroupFlex
                  (progn
                    (setq ss (ssadd))
                    (ssadd (vlax-vla-object->ename newpline) ss)
                    (ssadd (vlax-vla-object->ename newpline2) ss)
                    (or DelCl (ssadd cl-ent ss))
                    (if (vl-cmdf "_.-group" "_create" "*" "" ss "")
                      (princ "\nGrouping Done")
                      (princ "\nError Grouping")
                    )
                  )
                )

               )
             ) ; cond
           )        ; progn
           (princ "\nError - Can not use that object, Try again.")
         )          ; endif
         t
        )
        (t (princ "\nMissed Try again."))
      )             ; cond stmt
    )               ; progn
  )                 ; while
  (vla-endundomark doc)
  (vlax-release-object space)
  (vlax-release-object doc)
  ;;-----------  E N D   O F   L I S P  ----------------------------
  (princ)
)
(prompt "\nFlex Duct loaded, Enter FLEX to run.")
(princ)


Ok I've put in what I have come up with. I just dumped my flex routine into the flex2point code posted here. I had to change myflex to c:flex to get it to work. If anyone cares to test it you will see the flex part works ok, but the flex2point does just a line now with no flex. The line path generated needs fixing (radius size and initial stright length) but I can sort that later I hope.

Sorry if I'm stuffing anyone around but I am flying blind a bit here. It is however worth pursuing as I think this point to point lisp could save a lot of time in this drawing office.

[CAB]

This line is in the wrong place:

Code: [Select]

(vl-load-com)
Put it above the following line:

Code: [Select]

(defun c:Flex()
Most people who use lisp add that to there acaddoc.lsp file.


Back on Monday....

[Derek]

Thanks. Got this error now.  'Pick end point of duct.; error: too many arguments'

What is the acaddoc.lsp file? More importantly, is there some literature anywhere to help with learning this stuff?

Thanks for the feedback. Have a good weekend Charles.

[Lee Mac]

What is the acaddoc.lsp file? More importantly, is there some literature anywhere to help with learning this stuff?

Upon opening a drawing AutoCAD will search all support paths + the working directory for a file called the ACADDOC.lsp and load the first one it finds.

Hence most users will load their routines/execute startup functions [such as (vl-load-com) ] using the ACADDOC.lsp as it is a more stable method than the Startup Suite.

Coincidentally, I've just added a snippet about the ACADDOC.lsp to my site, although it probably needs a going over, it may be of some help to you:

http://lee-mac.com/runlisp.html

[Derek]

If autocad loads the first lisp it finds, using the acaddoc.lsp described, does this mean that only the one lisp routine will be loaded?

[Lee Mac]

If autocad loads the first lisp it finds, using the acaddoc.lsp described, does this mean that only the one lisp routine will be loaded?

It will load the first ACADDOC.lsp file it finds, this file can load many routines.

Two main ways users tend to load routines using the ACADDOC.lsp is either using the 'load' function hence:

Code: [Select]

(load "C:\\MyFolder\\MyLISP.lsp" "Load Failed")
(Path not required if lsp is in support path).

Or using Autoload:

Code: [Select]

(autoload "C:\\MyFolder\\MyLISP.lsp" '("Command1" "Command2"))
This method only loads a small fragment of code at startup, then demand loads the full LISP program when the user enters the command at the command line.

Lee

[Krushert]

Code: [Select]

(load "C:\\MyFolder\\MyLISP.lsp"[b] "Load Failed"[/b])

How does the error work in the code.  I understand that if the file is not found and loaded, it returns the error.  But how does it work? More on a nut and bolt level of how does it work.

[alanjt]

Code: [Select]

(load "C:\\MyFolder\\MyLISP.lsp"[b] "Load Failed"[/b])

How does the error work in the code.  I understand that if the file is not found and loaded, it returns the error.  But how does it work? More on a nut and bolt level of how does it work.

Code: [Select]

Command: (load "pizza.lsp" nil)
nil

Command: (load "pizza.lsp")
Error: LOAD failed: "pizza.lsp"

Command: (load "pizza.lsp" "nope")
"nope"

Command: (load "distanceinquiry.lsp" "nope")
C:DISTANCEINQUIRY

[Krushert]

Alanjt,

I understand that part of and I can test for it and have. 

I want to look under the hood to see how all the little sub-assemblies work and follow it thru.  Or am I not allowed to look under the hood?