帮助：绘制线

advex · 发表于 2022-7-6 08:49:29

我正在寻找一个应用程序来解决以下问题：
我有一个有许多点p1，p2。。。pn。
能够选择一个点，并绘制从选定点到图形中其他点的线。
谢谢

Tharwat · 发表于 2022-7-6 08:54:37

这对你有帮助吗？


(defun c:TesT (/ ss p i sname p1 a)
 ;; Tharwat 07. Oct. 2011 ;;
 (if (setq ss (ssget '((0 . "POINT"))))
   (progn
     (setq p (assoc 10 (entget (ssname ss 0))))
     (repeat (setq i (sslength ss))
       (setq sname (ssname ss (setq i (1- i))))
       (setq p1 (cdr (assoc 10 (entget sname))))
       (entmakex (list '(0 . "LINE") p (setq a (cons 11 p1))))
       (setq p (cons 10 (list (nth 1 a) (nth 2 a) (nth 3 a))))
     )
   )
   (princ)
 )
 (princ)
)

塔瓦特

Tharwat · 发表于 2022-7-6 08:57:38

将点与线连接的路线将根据点的逐个创建，这意味着首先创建的点
在图纸中，将提前拥有该属性。

当做

advex · 发表于 2022-7-6 09:01:14

感谢您的快速回复。
我的英语不好，要求略有不同。。。。我希望附上一张有启发性的照片！
从选定的点将绘制到其他点的线。

Tharwat · 发表于 2022-7-6 09:05:34

为了在寻找时获得最佳结果，请先选择基点，然后选择其余点。

试试这个。。

copy


(defun c:TesT (/ ss p i sname p1 )
 ;; Tharwat 07. Oct. 2011 ;;
 (if (setq ss (ssget '((0 . "POINT"))))
   (progn
     (setq p (assoc 10 (entget (ssname ss 0))))
     (repeat (setq i (sslength ss))
       (setq sname (ssname ss (setq i (1- i))))
       (setq p1 (cdr (assoc 10 (entget sname))))
       (entmakex (list '(0 . "LINE") p (cons 11 p1)))
     )
   )
   (princ)
 )
 (princ)
)

塔瓦特

advex · 发表于 2022-7-6 09:11:03

非常感谢。祝你一切顺利！

Tharwat · 发表于 2022-7-6 09:13:45

随时欢迎你。

Lee Mac · 发表于 2022-7-6 09:17:10

另一个想法：

copy

(defun c:test ( / a b g i l p s u )
   (if (setq s (ssget '((0 . "POINT"))))
       (progn
           (repeat (setq i (sslength s))
               (setq p (assoc 10 (entget (ssname s (setq i (1- i)))))
                     u (cons (trans (cdr p) 0 1) u)
                     l (cons p l)
               )
           )
           (princ "\nSelect Point: ")
           (while
               (progn (setq g (grread t 13 2) a (car g) b (cadr g))
                   (cond
                       (   (= 5 a) (redraw)
                           (foreach x u (grdraw x b 1 1)) t
                       )
                       (   (= 3 a)
                           (if (setq s (ssget b '((0 . "POINT"))))
                               (progn
                                   (setq p (cdr (assoc 10 (entget (ssname s 0)))))
                                   (foreach x l (entmakex (list (cons 0 "LINE") x (cons 11 p)))) nil
                               )
                               (princ "\nPlease Select a Point.")
                           )
                       )
                   )
               )
           )
       )
   )
   (redraw) (princ)
)

advex · 发表于 2022-7-6 09:22:13

想法值一打硬币，但付诸行动的人是无价之宝。（非洲问题b）

李-谢谢！

Lee Mac · 发表于 2022-7-6 09:25:58

非常周到的报价，我喜欢。

干杯

[编程交流] 帮助：绘制线

发表回复

精选推荐