Autolisp挑战#001

samifox · 发表于 2022-7-5 17:53:40

你好

我有一张画有两个圆圈和一个正方形的画。第一个圆圈是蓝色的，第二个是红色的。每当鼠标穿过红色圆圈时，我希望正方形有一个红色的图案填充，蓝色的也一样。

提前感谢，
谢伊
ch001.dwg

ReMark · 发表于 2022-7-5 18:02:07

任何填充图案。

任何比例。

任何旋转。

任何颜色。

在任何层上。

正方形没有阴影，因为它们是。。。。。正方形？

这给解释留下了很大的余地，不是吗？

samifox · 发表于 2022-7-5 18:06:42

我添加了一个dwg文件。一切都在那里。如果我没有具体说明，你只需要给它一个生命。。这意味着它将被解除。

Tharwat · 发表于 2022-7-5 18:11:56

你好
这个线程不应该被认为是一个挑战，因为许多程序员可以在下面编写与我相同或类似的程序；

copy


(defun c:Test (/ gr i lst e s ent)
 ;; Tharwat 22.03.2016 ;;
 (princ "\nSelect hatches to color :")
 (if (setq s (ssget "_:L" '((0 . "HATCH"))))
   (progn
     (repeat (setq i (sslength s))
       (setq lst (cons (ssname s (setq i (1- i))) lst))
     )
     (princ "\nMove cursor over a circle :")
     (while (eq (car (setq gr (grread t 15 0))) 5)
       (redraw)
       (if (and (setq e (ssget (cadr gr)))
                (eq (cdr (assoc 0 (setq ent (entget (ssname e 0))))) "CIRCLE" )
           )
         (mapcar '(lambda (x) (entmod (append (entget x) (list (assoc 62 ent))))) lst)
       )
     )
   )
 )
 (princ)
)

Lee Mac · 发表于 2022-7-5 18:13:51

快速书写，适用于任意数量的圆和任意数量的图案填充：

copy

(defun c:challenge001 ( / cil cir col cur enx fun hal hat idx )
   (setq fun '(( x ) (if (assoc 62 x) x (append x '((62 . 256))))))
   (cond
       (   (not (setq hat (ssget "_X" '((0 . "HATCH") (410 . "Model")))))
           (princ "\nNo hatches found.")
       )
       (   (not (setq cir (ssget "_X" '((0 . "CIRCLE") (410 . "Model")))))
           (princ "\nNo circles found.")
       )
       (   (repeat (setq idx (sslength hat))
               (setq hal (cons (fun (entget (ssname hat (setq idx (1- idx))))) hal))
           )
           (repeat (setq idx (sslength cir))
               (setq enx (fun (entget (ssname cir (setq idx (1- idx)))))
                     cil (cons (list (cdr (assoc 10 enx)) (cdr (assoc 40 enx)) (assoc 62 enx)) cil)
               )
           )
           (while (= 5 (car (setq cur (grread t 13 0))))
               (setq cur (trans (cadr cur) 1 0)
                     col (cond ((vl-some '(lambda ( x ) (if (< (distance cur (car x)) (cadr x)) (last x))) cil)) ('(62 . 7)))
               )
               (foreach enx hal (entmod (subst col (assoc 62 enx) enx)))
           )
       )
   )
   (princ)
)

samifox · 发表于 2022-7-5 18:20:37

干得好，塔尔瓦！如此轻盈优雅！我不知道ssget可以基于坐标选择实体
我忘了提到的一件事是，当用户离开其中一个圆时，图案填充应该恢复为白色。

samifox · 发表于 2022-7-5 18:24:42

图案填充的颜色交换是如何发生的？

copy

(mapcar '(lambda (x) (entmod (append (entget x) (list (assoc 62 ent))))) lst)

Tharwat · 发表于 2022-7-5 18:28:29

通过dxf代码62和变量“ent”表示entget列表，因此无论所选圆的颜色是什么，图案填充的颜色都会相应更改。

samifox · 发表于 2022-7-5 18:33:21

你的背景是什么？

Tharwat · 发表于 2022-7-5 18:38:33

打扰一下

[编程交流] Autolisp挑战#001

发表回复

精选推荐