社区 › Auto Lisp › 更改重复点的层

CADWORKER 发表于 2022-7-5 23:46:08

更改重复点的层

大家好，
 
我有一张图，其中有许多点，其中东距和北距相同，但这些点的高程不同。我正在寻找lisp，它可以选择这些点，并将较高海拔的点分离到一个图层，将较低海拔的点分离到不同的图层。
 
提前感谢，祝所有用户新年快乐。

Snownut 发表于 2022-7-5 23:49:34

为了有机会得到正确的答案，您需要发布图形文件，以便做出响应的人能够知道点由什么组成，以及如何自动选择它们。

eldon 发表于 2022-7-5 23:55:40

你是否试过拍摄正面视图，在那里可以立即看到不同的海拔高度？您甚至可以手动选择它们，这样就不用编写自己的lisp。
 
但是，和以往一样，张贴一张图纸将有助于给出最佳回复。

ymg3 发表于 2022-7-5 23:58:02

CADWORKER，
 
假设我们讨论的是点实体，那么应该使用以下方法：
 
新年快乐！！
 
ymg公司
 

(defun c:movdup (/ a b dl en enl i pl ss)
(setq pl nildl nil)
(princ "\nSelect Points: ")
(if (setq ss (ssget '((0 . "POINT"))))
   (progn
         (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
                   pl (cons (cons (cdr (assoc 10 (entget en))) en) pl))            
         )   
         (setq pl (vl-sort pl (function (lambda (a b) (< (caddar a) (caddar b))))) ;; Sort on Z Coordinate   
               pl (vl-sort pl (function (lambda (a b) (< (cadar a) (cadar b)))))   ;; Sort on Y Coordinate   
               pl (vl-sort pl (function (lambda (a b) (< (caar a) (caar b)))))   ;; Sort on X Coordinate   
               dl (vl-remove nil
                     (mapcar '(lambda (a b) (if (equal (cdr (reverse (car a))) (cdr (reverse (car b)))) (cdr a)))
                              pl (append (cdr pl) (list (car pl)))
                     )
                  )
         )
      
         ;; dl should now be a list of ename of duplicate points.                ;
         
         (foreach en dl
            (setq enl (entget en))
            (entmod (subst (cons 8 "Lower Duplicate Points") (assoc 8 enl) enl ))
         )
   )
)
)

marko_ribar 发表于 2022-7-6 00:00:28

我在这里回答了类似的问题：
 
http://www.cadtutor.net/forum/showthread.php?83202-Z坐标-将所有对象移动到0，并定义空间。
 
也许，你可以用它，但它和你的要求没什么不同。。。
 
没关系，新年快乐。。。
 
M、 R。

Lee Mac 发表于 2022-7-6 00:03:34

还有一种方法：

(defun c:fixpoints ( / e i l s )
   (if (setq s (ssget "_:L" '((0 . "POINT"))))
       (progn
         (repeat (setq i (sslength s))
               (setq e (ssname s (setq i (1- i)))
                     l (cons (cons (assoc 10 (entget e)) e) l)
               )
         )
         (foreach x
               (LM:groupbyfunction l
                   (lambda ( a b )
                     (equal
                           (list (cadar a) (caddar a))
                           (list (cadar b) (caddar b))
                           1e-8
                     )
                   )
               )
               (foreach x (cdr (vl-sort x '(lambda ( a b ) (> (last (car a)) (last (car b))))))
                   (entmod (list (cons -1 (cdr x)) '(8 . "Lower Points")))
               )
         )
       )
   )
   (princ)
)

;; Group By Function-Lee Mac
;; Groups items considered equal by a given predicate function

(defun LM:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
   (if (setq x1 (car lst))
       (progn
         (foreach x2 (cdr lst)
               (if (fun x1 x2)
                   (setq tmp1 (cons x2 tmp1))
                   (setq tmp2 (cons x2 tmp2))
               )
         )
         (cons (cons x1 (reverse tmp1)) (LM:groupbyfunction (reverse tmp2) fun))
       )
   )
)
(princ)

ymg3 发表于 2022-7-6 00:06:59

李，
 
不知道效率低下的地方在哪里，但如果irun在5000点列表上修复了3个重复点。
 
我的时机越来越不好。在60到83秒之间（变化很大）。
 
相反，Movdup只需0.3秒。
 

$ (c:fixpoints)

    Fixpoints - Elapsed time: 66.2220 secs.
_$ (c:movdup)

Select Points:
    Movdup - Elapsed time: 0.2970 secs.
_$

 
ymg公司
测试重复。图纸

Lee Mac 发表于 2022-7-6 00:11:33

瓶颈可能是LM:groupbyfunction函数，因为如果重复项很少，该函数将在整个列表中迭代多次，重复项越多，效率就越高。
 
排序方法当然更优化，但是，这当然取决于排序算法，在按每个坐标排序时不会严重干扰列表项的相对位置？

ymg3 发表于 2022-7-6 00:12:16

李，
 
不知道OP的典型特征是什么。
 
但我希望你的函数能在三角测量中使用它。
通常情况下，你会在一个大的点列表中找到一些重复的点。
 
至于排序，三角剖分通常只需要对坐标的X值进行排序。
 
新年快乐
 
ymg公司

Lee Mac 发表于 2022-7-6 00:17:08

很抱歉让ymg失望了-我必须想一个更好的算法
 
祝你新年快乐！
 
李

查看完整版本: 更改重复点的层