Jump to content

Recommended Posts

Posted

Was just messing around, thought you guys might like this -

 

Will make any regular polygon on the fly, have a play around with TAB, + and -.

 

;; Make Polygon by Lee McDonnell (Lee Mac)
;; 29.05.2009

(defun c:mkPly (/ flag doc spc clr pt gr cPt
                 Ang cAng cDis ptLst var)
 (vl-load-com)
 
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop
                 (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc))
       clr 0)
 
 (or *mkPly:Side* (setq *mkPly:Side* 4))
 (if (setq pt (getpoint "\nSelect Centre Point: "))
   (progn
     (while
       (or
         (and
           (setq gr (grread t 7 0)) (eq 5 (car gr)))
         (and
           (eq 2 (car gr))
             (member
               (cadr gr)
                 '(9 43 61 45))))
       (redraw)
       (if
         (and
           (eq 2 (car gr))
           (or
             (eq 43 (cadr gr)) ; +
             (eq 61 (cadr gr)))) ; = (as +)
           (setq *mkPly:Side* (+ *mkPly:Side* (if flag 2 1))
                 clr (1+ clr)))
       (if
         (and
           (eq 2 (car gr))
           (eq 45 (cadr gr))) ; -
         (progn
           (and (< (if flag 6 3) *mkPly:Side*)
                (setq *mkPly:Side*
                  (- *mkPly:Side* (if flag 2 1))))
           (if (zerop clr)
             (setq clr 5)
             (setq clr (1- clr)))))
       (if
         (and
           (eq 2 (car gr))
           (eq 9 (cadr gr))) ; Tab
         (progn
           (setq flag (not flag))
           (if flag
             (setq *mkPly:Side* 6))))
       (if (eq 5 (car gr))
         (progn
           (setq cPt (cadr gr)
                 Ang (/ (* 2. pi) *mkPly:Side*)
                 cAng (angle pt cPt)
                 cDis (distance pt cPt)
                 ptLst (list cPt (polar pt (+ cAng Ang)
                                        (if (and flag (< 5 *mkPly:Side*)
                                                 (zerop (rem *mkPly:Side* 2)))
                                          (/ cDis 3.) cDis))) i 2.)
           (repeat (- *mkPly:Side* 2)
             (setq ptlst
               (append ptlst
                 (list (last ptlst)
                   (polar pt (+ cAng (* i Ang))
                          (if (and flag (< 5 *mkPly:Side*)
                                   (zerop (rem *mkPly:Side* 2))
                                   (not (zerop (rem i 2))))
                            (/ cDis 3.) cDis)))) i (1+ i)))))
       (grvecs
         (setq ptlst
           (append
             (list (* -1 (1+ (rem clr 6))))
               ptlst (list (last ptlst) cPt)))))
     (if
       (and
         (eq 3 (car gr))
           (listp (cadr gr)))
       (progn
         (setq ptlst (apply
                       'append
                          (mapcar
                            (function
                              (lambda (x)
                                (list (car x) (cadr x))))
                            (append
                              (unique (cdr ptlst))
                                (list (cadr ptlst))))))
         (setq var
           (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray
                 vlax-vbdouble
                   (cons 0 (1- (length ptlst))))
               ptlst)))          
         (vla-addLightWeightPolyline spc var)))
     (redraw)))
 (princ))

;; CAB
(defun unique (lst / result)
 (reverse
   (while (setq itm (car lst))
     (setq lst (vl-remove itm lst)
           result (cons itm result)))))

Posted

Not bad, I like how you can choose size and rotation. But isn't this strikingly similar to the AutoCAD command "Polygon"?

Posted

It's definitely neat. Refill I'm surprised you don't like it more with your strange obsession with grread. lol

Posted

I do like it. It's hard to fully appreciate Lee's LISPs because most of the time I don't understand them. o.o'

 

I did notice what could be a bug, however. When on the "star" option, you can tab back to the "polygon" option and keep the same number of sides, but it seems when you're on the "polygon" option and tab into the "star" option, it reverts to a 3-sided star. If you tab back, it goes to a 6-sided polygon. If you subtract a side, it turns into a square.

 

Still, it's very nice. I like the colours and the use of vectors.

Posted
Not bad, I like how you can choose size and rotation. But isn't this strikingly similar to the AutoCAD command "Polygon"?

 

Yup - but maybe quicker :P

 

I do like it. It's hard to fully appreciate Lee's LISPs because most of the time I don't understand them. o.o'

 

I did notice what could be a bug, however. When on the "star" option, you can tab back to the "polygon" option and keep the same number of sides, but it seems when you're on the "polygon" option and tab into the "star" option, it reverts to a 3-sided star. If you tab back, it goes to a 6-sided polygon. If you subtract a side, it turns into a square.

 

Still, it's very nice. I like the colours and the use of vectors.

 

Yeah, the star needs an even number of sides (min 6), so I just set it to 6 when you hit tab. But I didn't spend too long writing this, so I guess it could be improved to use the even number below the current number of sides or something similar.

 

 

But thanks for the comments guys :D

Posted

Lee,

 

Would you be able to point me in the direction of how you created phantom object?

 

 

Much appreciated

 

Flower

Posted
Lee,

 

Would you be able to point me in the direction of how you created phantom object?

 

 

Much appreciated

 

Flower

 

The GRVECS or GRDRAW functions will draw the "phantom" objects on the screen - a negative colour value for the GRVECS function will indicate a highlighted (dashed) line. :)

 

Lee

Posted

Hi Lee, I don't have a use for it but it is a nice routine!

The thing with teh tab + gives nice stars... getting the christmas feel...

Posted
Hi Lee, I don't have a use for it but it is a nice routine!

The thing with teh tab + gives nice stars... getting the christmas feel...

 

Thanks Marco -

 

It was just a little bit of fun on the side - just experimenting with GRVECS, GRREAD etc. :)

 

I'm glad you like it :)

 

Lee

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...