社区 › Auto Lisp › 删除点

jevrem1 发表于 2022-7-5 21:40:04

删除点

Lisp需要删除插入块所在的点。

ttray33y 发表于 2022-7-5 21:47:48

如果你能提供给我的朋友，快照肯定会有帮助。

jevrem1 发表于 2022-7-5 21:51:39

必须删除指定点

Tharwat 发表于 2022-7-5 21:55:49

试试这个。
 

Removed ...

jevrem1 发表于 2022-7-5 22:02:59

 
 
 
您的lisp不在本例中。点不是块的一部分。点与插入块重合。应删除此点。

Tharwat 发表于 2022-7-5 22:08:56

从你的回复中删除我的代码。

Lee Mac 发表于 2022-7-5 22:11:40

请尝试以下代码：
(defun c:delpoints ( / e i l p s x )
   (if (setq s (ssget "_:L" '((0 . "INSERT,POINT"))))
       (progn
         (repeat (setq i (sslength s))
               (setq e (ssname s (setq i (1- i)))
                     x (entget e)
               )
               (if (= "INSERT" (cdr (assoc 0 x)))
                   (setq l (cons (trans (cdr (assoc 10 x)) e 0) l))
                   (setq p (cons (cons(cdr (assoc 10 x)) e) p))
               )
         )
         (foreach x p
               (if (vl-some '(lambda ( y ) (equal (car x) y 1e-4)) l)
                   (entdel (cdr x))
               )
         )
       )
   )
   (princ)
)

jevrem1 发表于 2022-7-5 22:16:19

对就是这样。杰出的可以用lisp在全球范围内工作。能够注册或选择块的名称。那么影响就越大。

Lee Mac 发表于 2022-7-5 22:21:14

 
当然-更换：
"_:L"
使用：
"_X"
自动处理图形中的所有块和点。
 
但是，您可能希望向ssget过滤器列表中添加更多过滤器，例如仅处理当前布局中的块/点，或仅处理特定名称的块等。您可以通过将第一行更改为：
    (if (setq s (ssget "_X" (list '(0 . "INSERT,POINT") '(2 . "YourBlockName") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))

jevrem1 发表于 2022-7-5 22:27:06

谢谢李。随着代码的变化，lisp可以完美地工作。换了第一行，什么也没发生。附上更改后的代码。
(defun c:delpoints ( / e i l p s x )
   (if (setq s (ssget "_X" (list '(0 . "INSERT,POINT") '(2 . "TK414S3") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
       (progn
         (repeat (setq i (sslength s))
               (setq e (ssname s (setq i (1- i)))
                     x (entget e)
               )
               (if (= "INSERT" (cdr (assoc 0 x)))
                   (setq l (cons (trans (cdr (assoc 10 x)) e 0) l))
                   (setq p (cons (cons(cdr (assoc 10 x)) e) p))
               )
         )
         (foreach x p
               (if (vl-some '(lambda ( y ) (equal (car x) y 1e-4)) l)
                   (entdel (cdr x))
               )
         )
       )
   )
   (princ)
)

查看完整版本: 删除点