Making a polyline box using lisp

July 9, 2010

Its not that hard to make , you need to know the varies lengths of your pose and with " polar " function you can create it easily.

Regards

Tharwat

I have never used lisp before. so when you talk like that, it doesn't help. im not trying to be rude, im trying to learn and just saying it is easy doesn't help.

July 9, 2010

Hi lesliematt.

Do not worry I will make it for you as soon as possible , But you have to support more details about your pose that you attached earlier .

so the details like lengths of lines, Angles, ....... etc.

Feel free to ask about any help. In this Forum all members are helping each other with no hesitation.

It just a matter of time.

Best regards

Tharwat

July 9, 2010

Thank you for being courteous. here is an image of what i need. the red one will overlay the purple one. I would like to be able to give a length and width of the red one, (p1 and p2) as well as a starting point. Then it will draw out the rest.

start on layer 'plate' (red)

global width of 0.0625

starting point

enter length

enter width

draw red

switch to layer x-laser (purple)

global width of 0.04

redraw red

then use a formula to draw the outer shape.

I am not sure if it is easier to offset, then make a generic 30 degree corner that gets mirrored around to each corner and then trim, or to just command a line that will have logic on where to draw the shape. any help is appreciated.

July 9, 2010

it will also promt the user as tothe depth of the box. ergo the flaps on the purple one will be dependant on the user.

July 9, 2010

Draw Rect, Complicated

(defun c:SQ (/ foo p1 pt w h p2 ent)

;; Draw square polygon at specified height and width

(command "layer" "s" "Plate" "")

(defun foo (p) (list 10 (car p) (cadr p)))

(if (and (setq p1 (getpoint "\nSpecify NorthWest corner of rectangle: "))

(setq w (getdist "\nSpecify width: "))

(setq h (cond ((getdist (strcat "\nSpecify height : ")))

(w)

)

)

)

(progn

(setq p2 (polar (setq pt (trans p1 1 0)) 0. w))

(if (setq ent (entmakex

(append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")

'(90 . 4) '(70 . 1)

)

(mapcar 'foo

(list pt p2 (polar p2 (* 1.5 pi) h) (polar pt (* 1.5 pi) h))

)

)

)

)

(command "layer" "s" "X-Laser" "")

)

)

)

(princ)

)

This is a good start, and some ppl have helped me get this far. now im stuck tho

July 9, 2010

Hi

What do you mean by the global width ... ????? And at the same time you what the program to ask the user to insert the width also.

You would better also give the offset distance for the purple rectangle

(from red one to outside pose gap distance).

Regards

Tharwat

July 9, 2010

Hi
What do you mean by the global width ... ????? And at the same time you what the program to ask the user to insert the width also.

You would better also give the offset distance for the purple rectangle

(from red one to outside pose gap distance).

Regards

Tharwat

the offset distance on that specific one is 10". what i mean by global width is the thickness of the red box needs to be 0.0625, and the thickness of the purple one is 0.04. in properties, it is called global width.

July 9, 2010

As its Friday

;; Rectangle as per LeslieMatt's Specs :-)

(defun c:CustRec ( / *error* LWPoly lay1 lay2 doc p1 p2 undo norm )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq lay1 "plate" lay2 "x-laser") ;; Layer Control

 (defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun LWPoly ( lst cls lay wid )
   (entmakex
     (append
       (list
         (cons 0 "LWPOLYLINE")
         (cons 8 lay)
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbPolyline")
         (cons 90 (length lst))
         (cons 70 cls)
         (cons 43 wid)
       )
       (mapcar '(lambda ( p ) (cons 10 p)) lst)
     )
   )
 )

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (and (setq p1 (getpoint  "\nSpecify First Corner:  "))
          (setq p2 (getcorner "\nSpecify Second Corner: " p1))
          (setq fl (getdist   "\nSpecify Depth: " p1)))
   (progn
     (setq undo (not (vla-StartUndoMark doc)))

     (setq norm (trans '(0. 0. 1.) 1 0 t) d (distance p1 p2))

     (mapcar
      '(lambda ( lst lay wid )
         (LWPoly
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) lst)
           )
           1 lay wid
         )
       )
       (list (list p1 p2)
         (mapcar
          '(lambda ( p )
             (set p (polar (eval p) 0 d))
           )
          '( p1 p2 )
         )
       )
       (list lay1 lay2) (list 0.0625 0.04)
     )
     
     (mapcar 'set '(p1 p2)
       (mapcar
        '(lambda ( foo )
           (apply 'mapcar (cons foo (list p1 p2)))
         )
        '(min max)
       )
     )
     
     (LWPoly
       (apply 'append
         (mapcar
          '(lambda ( p a )
             (list
               (polar p (- a (/ pi 12.)) (/ fl (cos (/ pi 6))))
               p
               (polar p (+ a (/ pi 12.)) (/ fl (cos (/ pi 6))))
             )
           )                 
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) (list p1 p2))
           )
           (list (* 5. (/ pi 4.)) (* 7. (/ pi 4.)) (/ pi 4.) (* 3. (/ pi 4.)))
         )
       )
       1 lay2 0.04
     )
     
     (setq undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

July 9, 2010

wow, that is incredible. how do i change it so both will be in line with each other. ergo one directly ontop of the other?

July 9, 2010

The code currently creates three poly's - the red one, and two purple (one of which is identical to the red one, but of a different pline width), are you saying you want the red on on top of the purple one? - I just followed your pic

July 9, 2010

The code currently creates three poly's - the red one, and two purple (one of which is identical to the red one, but of a different pline width), are you saying you want the red on on top of the purple one? - I just followed your pic

I no you just followed the pic, lol. It works perfect. but i actually needed them inline with each other, so the red one is directly over the purple.

p.s. how long have you been working with lisp?

July 9, 2010

idealy just like this

July 9, 2010

I no you just followed the pic, lol. It works perfect. but i actually needed them inline with each other, so the red one is directly over the purple.

p.s. how long have you been working with lisp?

Ok, no worries.

About a year and a half I think.

July 9, 2010

Try this:

;; Rectangle as per LeslieMatt's Specs :-)

(defun c:CustRec ( / *error* LWPoly lay1 lay2 doc p1 p2 fl undo norm )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq lay1 "plate" lay2 "x-laser") ;; Layer Control

 (defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun LWPoly ( lst cls lay wid )
   (entmakex
     (append
       (list
         (cons 0 "LWPOLYLINE")
         (cons 8 lay)
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbPolyline")
         (cons 90 (length lst))
         (cons 70 cls)
         (cons 43 wid)
       )
       (mapcar '(lambda ( p ) (cons 10 p)) lst)
     )
   )
 )

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (and (setq p1 (getpoint  "\nSpecify First Corner:  "))
          (setq p2 (getcorner "\nSpecify Second Corner: " p1))
          (setq fl (getdist   "\nSpecify Depth: " p1)))
   (progn
     (setq undo (not (vla-StartUndoMark doc)))

     (setq norm (trans '(0. 0. 1.) 1 0 t))

     (mapcar 'set '( p1 p2 )
       (mapcar
        '(lambda ( foo )
           (apply 'mapcar (cons foo (list p1 p2)))
         )
        '(min max)
       )
     )

     (LWPoly
       (apply 'append
         (mapcar
          '(lambda ( p a )
             (list
               (polar p (- a (/ pi 12.)) (/ fl (cos (/ pi 6))))
               p
               (polar p (+ a (/ pi 12.)) (/ fl (cos (/ pi 6))))
             )
           )                 
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) (list p1 p2))
           )
           (list (* 5. (/ pi 4.)) (* 7. (/ pi 4.)) (/ pi 4.) (* 3. (/ pi 4.)))
         )
       )
       1 lay2 0.04
     )

     (mapcar
      '(lambda ( lst lay wid )
         (LWPoly
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) lst)
           )
           1 lay wid
         )
       )
       (list
         (list p1 p2)
         (list p1 p2)
       )       
       (list lay2 lay1) (list 0.04 0.0625)
     )
     
     (setq undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

July 9, 2010

Try this:

;; Rectangle as per LeslieMatt's Specs :-)

(defun c:CustRec ( / *error* LWPoly lay1 lay2 doc p1 p2 fl undo norm )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq lay1 "plate" lay2 "x-laser") ;; Layer Control

 (defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun LWPoly ( lst cls lay wid )
   (entmakex
     (append
       (list
         (cons 0 "LWPOLYLINE")
         (cons 8 lay)
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbPolyline")
         (cons 90 (length lst))
         (cons 70 cls)
         (cons 43 wid)
       )
       (mapcar '(lambda ( p ) (cons 10 p)) lst)
     )
   )
 )

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (and (setq p1 (getpoint  "\nSpecify First Corner:  "))
          (setq p2 (getcorner "\nSpecify Second Corner: " p1))
          (setq fl (getdist   "\nSpecify Depth: " p1)))
   (progn
     (setq undo (not (vla-StartUndoMark doc)))

     (setq norm (trans '(0. 0. 1.) 1 0 t))

     (mapcar 'set '( p1 p2 )
       (mapcar
        '(lambda ( foo )
           (apply 'mapcar (cons foo (list p1 p2)))
         )
        '(min max)
       )
     )

     (LWPoly
       (apply 'append
         (mapcar
          '(lambda ( p a )
             (list
               (polar p (- a (/ pi 12.)) (/ fl (cos (/ pi 6))))
               p
               (polar p (+ a (/ pi 12.)) (/ fl (cos (/ pi 6))))
             )
           )                 
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) (list p1 p2))
           )
           (list (* 5. (/ pi 4.)) (* 7. (/ pi 4.)) (/ pi 4.) (* 3. (/ pi 4.)))
         )
       )
       1 lay2 0.04
     )

     (mapcar
      '(lambda ( lst lay wid )
         (LWPoly
           (
             (lambda ( data )
               (mapcar
                '(lambda ( funcs )
                   (mapcar
                    '(lambda ( func )
                       ((eval func) data)
                     )
                    funcs
                   )
                 )
                '((caar   cadar) (caadr  cadar)
                  (caadr cadadr) (caar  cadadr))
               )
             )
             (mapcar '(lambda ( p ) (trans p 1 norm)) lst)
           )
           1 lay wid
         )
       )
       (list
         (list p1 p2)
         (list p1 p2)
       )       
       (list lay2 lay1) (list 0.04 0.0625)
     )

     (setq undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

Perfect. Wow, you are impressive. does it have to be:

'pick first point'

'pick second point'

or can it be

'pick first point'

'enter length'

'enter width'

or does that change everything??

July 9, 2010

Thanks

It could of course be done, but I thought that as it stands it is better as the first pick doesn't have to be the lower left corner (or another fixed point) but rather can be any corner. Plus you should be able to enter the length and width as relative coordinates as it stands.

July 9, 2010

I also need one that will function in the same way, but make something that looks more like this. I really appreciate all the help if you can.

need.dwg

July 9, 2010

Bear in mind that my time is voluntary - I am not getting paid here.

July 9, 2010

Bear in mind that my time is voluntary - I am not getting paid here.

I do realize that Lee Mac, and i am extremely grateful. If you can help, there is no deadline. and it would be appreciated. I am trying to figure it out, but I am not really good at this stuff. Let me know what you think of this one. it doesn't need that much modification since its along the same lines.

July 9, 2010

Was bored this evening, this is as far as I'm going with this one.

;; Rectangle as per LeslieMatt's Specs :-)

(defun c:CustRec2 ( / *error* LWPoly lay1 lay2 doc p1 p2 fl undo norm bbox )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq lay1 "plate" lay2 "x-laser") ;; Layer Control

 (defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun LWPoly ( lst cls lay wid )
   (entmakex
     (append
       (list
         (cons 0 "LWPOLYLINE")
         (cons 8 lay)
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbPolyline")
         (cons 90 (length lst))
         (cons 70 cls)
         (cons 43 wid)
       )
       (mapcar '(lambda ( p ) (cons 10 p)) lst)
     )
   )
 )

 (defun tan ( x )
   (if (equal 0.0 (cos x) 1e-14) nil
     (/ (sin x) (cos x))
   )
 )      

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (and (setq p1 (getpoint  "\nSpecify First Corner:  "))
          (setq p2 (getcorner "\nSpecify Second Corner: " p1))
          (setq fl (getdist   "\nSpecify Depth: " p1)))
   (progn
     (setq undo (not (vla-StartUndoMark doc)))

     (setq norm (trans '(0. 0. 1.) 1 0 t))

     (mapcar 'set '( p1 p2 )
       (mapcar
        '(lambda ( foo )
           (apply 'mapcar (cons foo (list p1 p2)))
         )
        '(min max)
       )
     )

     (setq bbox
       (
         (lambda ( data )
           (mapcar
            '(lambda ( funcs )
               (mapcar
                '(lambda ( func )
                   ((eval func) data)
                 )
                funcs
               )
             )
            '((caar   cadar) (caadr  cadar)
              (caadr cadadr) (caar  cadadr))
           )
         )
         (mapcar '(lambda ( p ) (trans p 1 norm)) (list p1 p2))
       )
     )
     
     (LWPoly
       (list
         (car   bbox)
         (polar (car    bbox) 0. (/ fl (tan (* pi (/ 47. 180.)))))
         (polar (car    bbox) (/ (* 3. pi) 2.) fl)
         (polar (cadr   bbox) (/ (* 3. pi) 2.) fl)
         (polar (cadr   bbox) pi (/ fl (tan (* pi (/ 47. 180.)))))
         (cadr  bbox)

         (caddr bbox)
         (polar (caddr  bbox) pi (/ fl (tan (* pi (/ 47. 180.)))))
         (polar (caddr  bbox) (/ pi 2.) fl)
         (polar (cadddr bbox) (/ pi 2.) fl)
         (polar (cadddr bbox) 0  (/ fl (tan (* pi (/ 47. 180.)))))
         (cadddr bbox)
       )
       1 lay2 0.04
     )

     (LWPoly bbox 1 lay1 0.04)
     
     (setq undo (vla-EndUndoMark doc))
   )
 )
 (princ)
)

Sign In

Making a polyline box using lisp

Recommended Posts

Guest lesliematt

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Tharwat

Guest lesliematt

Guest lesliematt

Guest lesliematt

Tharwat

Guest lesliematt

Lee Mac

Guest lesliematt

Lee Mac

Guest lesliematt

Guest lesliematt

Lee Mac

Lee Mac

Guest lesliematt

Lee Mac

Guest lesliematt

Lee Mac

Guest lesliematt

Lee Mac

Join the conversation

Tutorials

Forums

Activity