社区 › Auto Lisp › 帮助：绘制线

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

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

(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

另一个想法：
 
 
(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

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

查看完整版本: 帮助：绘制线