Making a polyline box using lisp

[Guest lesliematt]

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)
)

 

 

thank you lee mac. i should be able to mod this. i wonder though what it means. i understand if you don't want to, but it would be appreciated if you could put some comments though the program so i can understand how it is working. let me know. and again thanks for getting me this far.