Jump to content

A LISP for when you are bored...

Lee Mac

By Lee Mac
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Lee Mac Grand Master

Lee Mac

Posted
Posted

... I was

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:bored [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] pt1 pt2 lst cnt gr[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt1 [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#ff00ff]"\nSelect First Point: "[/color][/b][b][color=RED])[/color][/b]
       pt2 [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#ff00ff]"\nSelect Second Point: "[/color][/b][b][color=RED])[/color][/b]
       lst [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] pt1 pt2[b][color=RED])[/color][/b] cnt [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] gr [b][color=RED]([/color][/b][b][color=BLUE]grread[/color][/b] [b][color=#009900]5[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst
     [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] lst
       [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]last[/color][/b] lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=#009900]100[/color][/b] cnt[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cddr[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cnt [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] cnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]grvecs[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rem[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] cnt [b][color=#009900]100[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]255[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

The Buzzard Veteran

The Buzzard

Posted
Posted

Lee,

 

You must be bored!:lol::lol::lol:

 

But it interesting.

Shawndoe Contributor

Shawndoe

Posted
Posted

Hi,

 

Really bored... Here's a little enhancment to bored.

 


(defun c:bored (/ pt1 pt2 lst cnt gr)
  (vl-load-com)
  (setq DisplayObj (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
  (setq pt1 (getpoint "\nSelect First Point: ")
        pt2 (getpoint "\nSelect Second Point: ")
        lst (list pt1 pt2) cnt 0)
  (vla-put-ModelCrosshairColor DisplayObj 0); Black
  (while (eq 5 (car (setq gr (grread 5))))
    (redraw)
    (setq lst
      (append lst
        (list (last lst) (cadr gr))))
    (if (< 100 cnt)
      (setq lst (cddr lst)))
    (setq cnt (1+ cnt))
    (grvecs (append (list (rem (/ cnt 100) 255)) lst)))
  (princ)
  (vla-put-ModelCrosshairColor DisplayObj 16777215); White
)
[/Code]
 
Have fun being bored . :)
Shawndoe
Lee Mac Grand Master

Lee Mac

Posted
  • Author
Posted

Easier way to do that buddy :)

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:bored  [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] pt1 pt2 lst cnt gr[b][color=RED])[/color][/b]
[i][color=#990099];;;  (vl-load-com)[/color][/i]
[i][color=#990099];;;  (setq DisplayObj (vla-get-display[/color][/i]
[i][color=#990099];;;                     (vla-get-preferences[/color][/i]
[i][color=#990099];;;                       (vlax-get-acad-object))))[/color][/i]
 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt1 [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#ff00ff]"\nSelect First Point: "[/color][/b][b][color=RED])[/color][/b]
       pt2 [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#ff00ff]"\nSelect Second Point: "[/color][/b][b][color=RED])[/color][/b]
       lst [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] pt1 pt2[b][color=RED])[/color][/b] cnt [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]
[i][color=#990099];;;  (vla-put-ModelCrosshairColor DisplayObj 0) ; Black[/color][/i]
 [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] gr [b][color=RED]([/color][/b][b][color=BLUE]grread[/color][/b] [b][color=BLUE]nil[/color][/b] [b][color=#009900]5[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst
     [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] lst
       [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]last[/color][/b] lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=#009900]100[/color][/b] cnt[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cddr[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cnt [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] cnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]grvecs[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]rem[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] cnt [b][color=#009900]100[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]255[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
[i][color=#990099];;;  (vla-put-ModelCrosshairColor DisplayObj 16777215) ; White[/color][/i]
 [b][color=RED])[/color][/b]

The Buzzard Veteran

The Buzzard

Posted
Posted

Lee,

 

If your that bored, I know of a nice little print manager that could use your help.

Lee Mac Grand Master

Lee Mac

Posted
  • Author
Posted

haha, I'm not that bored... got my first exam on Friday, should be revisin'...

The Buzzard Veteran

The Buzzard

Posted
Posted

No problem, I actually found a code that is simple to modify. Only thing is it will involve some DCL work.

 

Just a walk in the park for a gentlemen such as yourself.:P

Lee Mac Grand Master

Lee Mac

Posted
  • Author
Posted
No problem, I actually found a code that is simple to modify. Only thing is it will involve some DCL work.

 

Just a walk in the park for a gentlemen such as yourself.:P

 

Well, you say that, after spending a bit more time at the TheSwamp, I'm beginning to consider myself a beginner... :oops:

The Buzzard Veteran

The Buzzard

Posted
Posted

Hey, As far as I am concerned, Your number 1 here. I will make my best attempt at it anyway. After all, I have no boss to answer to. But you will be suprised to see that this code was done so easy, Most of the programmers here could have done it. I am just going to enhance it a bit.

alanjt Grand Master

alanjt

Posted
Posted
Well, you say that, after spending a bit more time at the TheSwamp, I'm beginning to consider myself a beginner... :oops:

man, i know exactly how you feel.

 

just to remove the requirement to pick 2 points...

(defun c:bored  (/ pt1 pt2 lst cnt gr)
;;;  (vl-load-com)
;;;  (setq DisplayObj (vla-get-display
;;;                     (vla-get-preferences
;;;                       (vlax-get-acad-object))))
 (setq pt1 (getvar "viewctr")
       pt2 (mapcar '(lambda (x) (* x x)) pt1)
       lst (list pt1 pt2) cnt 0)
;;;  (vla-put-ModelCrosshairColor DisplayObj 0) ; Black
 (while (eq 5 (car (setq gr (grread nil 5 1))))
   (redraw)
   (setq lst
     (append lst
       (list (last lst) (cadr gr))))
   (if (< 100 cnt)
     (setq lst (cddr lst)))
   (setq cnt (1+ cnt))
   (grvecs (append (list (rem (/ cnt 100) 255)) lst)))
 (princ)
;;;  (vla-put-ModelCrosshairColor DisplayObj 16777215) ; White
 )

Lee Mac Grand Master

Lee Mac

Posted
  • Author
Posted
Hey, As far as I am concerned, Your number 1 here. I will make my best attempt at it anyway.

 

Thanks Buzzard, I feel honoured - but there are many more experienced programmers on this site, who are just "less-active" than me.

 

Good luck with your modifications mate :)

 

man, i know exactly how you feel.

 

just to remove the requirement to pick 2 points...

(defun c:bored  (/ pt1 pt2 lst cnt gr)
;;;  (vl-load-com)
;;;  (setq DisplayObj (vla-get-display
;;;                     (vla-get-preferences
;;;                       (vlax-get-acad-object))))
 (setq pt1 (getvar "viewctr")
       pt2 (mapcar '(lambda (x) (* x x)) pt1)
       lst (list pt1 pt2) cnt 0)
;;;  (vla-put-ModelCrosshairColor DisplayObj 0) ; Black
 (while (eq 5 (car (setq gr (grread nil 5 1))))
   (redraw)
   (setq lst
     (append lst
       (list (last lst) (cadr gr))))
   (if (< 100 cnt)
     (setq lst (cddr lst)))
   (setq cnt (1+ cnt))
   (grvecs (append (list (rem (/ cnt 100) 255)) lst)))
 (princ)
;;;  (vla-put-ModelCrosshairColor DisplayObj 16777215) ; White
 )

 

Cheers Alan,

 

Great idea to get around the point choosing, I didn't really spend much time thinking about that, but great solution :)

 

Lee

alanjt Grand Master

alanjt

Posted
Posted
Thanks Buzzard, I feel honoured - but there are many more experienced programmers on this site, who are just "less-active" than me.

 

Good luck with your modifications mate :)

 

 

 

Cheers Alan,

 

Great idea to get around the point choosing, I didn't really spend much time thinking about that, but great solution :)

 

Lee

i just thought about viewctr because i use it sometimes to place text for calculation routines, that way i don't have to actually pick a placement point, since i'm going to delete it as soon as i fill in all my information.

ronjonp Grand Master

ronjonp

Posted
Posted

Nice one Lee :)

 

Here's a bit of my boredom mixed with your boredom :lol:.

 

(defun c:bored (/ cir cnt gr lst n d)
 (setq lst (list (getvar 'viewctr) (getvar 'viewctr))
       cnt 0
 )
 (while (eq 5 (car (setq gr (grread nil 5 1))))
   (redraw)
   (setq cir nil
         n   0
         lst (append lst (list (last lst) (cadr gr)))
         cnt (1+ cnt)
   )
   (if (< 100 cnt)
     (setq lst (cddr lst))
   )
   (repeat 50
     (setq d (/ (distance (car lst) (last lst)) 4.))
     (repeat 4
       (setq cir (cons (polar (car lst) (* (setq n (1+ n)) (/ (* pi 2) 50)) d) cir))
       (setq d (/ d 2.))
     )
   )
   (grvecs (append (list (rem (/ cnt 100) 255)) lst cir))
 )
 (princ)
)

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.

×
 Share
Go to topic listing
×
×
  • Create New...