当你感到无聊时的Lisp程序。

Lee Mac · 发表于 2022-7-6 14:32:06

... 我是


[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]

享受无聊的乐趣。
肖恩多
[/code]

The Buzzard · 发表于 2022-7-6 14:37:18

更简单的方法伙计

[code] (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]

Shawndoe · 发表于 2022-7-6 14:43:48

谢谢Buzzard，我感到很荣幸——但这个网站上有很多经验丰富的程序员，他们只是“不如我活跃”。

祝你的朋友好运

干杯，艾伦，

这是一个很好的选择，我并没有花太多时间思考这个问题，但这是一个很好的解决方案

李

Lee Mac · 发表于 2022-7-6 14:46:46

我只是想到了viewctr，因为我有时使用它来放置计算例程的文本，这样我就不必实际选择放置点，因为我将在填写完所有信息后立即删除它。

The Buzzard · 发表于 2022-7-6 14:51:38

不错，李

这是我的无聊和你的无聊交织在一起。

copy


[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]

Lee Mac · 发表于 2022-7-6 14:58:32

哈哈-辉煌的罗恩

The Buzzard · 发表于 2022-7-6 15:03:21

Lee Mac · 发表于 2022-7-6 15:07:06

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

The Buzzard · 发表于 2022-7-6 15:09:58

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 · 发表于 2022-7-6 15:14:22

man, i know exactly how you feel.

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

copy

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

[编程交流] 当你感到无聊时的Lisp程序。

发表回复

精选推荐