选择重复点
你好这是我的第一篇帖子，我是Autolisp新手。希望我不会打扰你。
因此，我制作了一个包含1000多个点的嵌套列表，其中的x，y，z坐标如下所示：
'（（x y z）（x y z）.）
在这个列表中有两个点；相同的X和Y，但不同的Z。我需要做的是选择Z更大的，并改变它们的层。
如果这是一项可能完成的任务，你能给我一些提示吗？ 听起来你在处理点实体？
是否希望使用最大Z轴值在每个公共位置处结束一个点，并删除该X Y位置处的所有其他点？
对此可能有很多不同的方法：
(defun c:maxz-dpt (/ lst f r c x)
(setq lst '((2 2 3)(2 2 4)(2 3 5)(2 2 1)(6 5 4)
))
;;VVA
(defun round (num prec)
(* prec (if (minusp num)
(fix (- (/ num prec) 0.5))
(fix (+ (/ num prec) 0.5)))))
(initget 6)
(setq f (getdist "\nPoint Value Tolerence <0.001>: "))
(or f (setq f 0.001))
(setq c nil)
(foreach p lst
(setq r (list (round (car p) f)
(round (cadr p) f)))
(if (assoc r c)
(setq c (subst (append (assoc r c) (list (caddr p)))
(assoc r c) c))
(setq c (cons (append (list r) (list (caddr p))) c))))
(foreach p c
(setq x (append (car p) (list (apply 'max (cdr p)))))
(prin1 x)
(princ"\n")
;;;WHAT TO DO HERE ???
)
(prin1))
处理点值时，最好使用模糊因子或舍入因子。
-大卫 大卫，非常感谢你的回复。
是的，我在处理点实体。
这是我列出清单的代码。我把图案改成
（x y z x y z….）
(defun d(/ a c)
(setq a (ssget))
(setq i 0)
(setq b (cdr(assoc 10 (entget(ssname a i)))))
(setq c b)
(setq n (sslength a))
(repeat (1- n)
(setq i (1+ i))
(setq b (cdr(assoc 10 (entget(ssname a i)))))
(setq c (append c b))
)
)
Civil 3d无法三角化重复点，我必须使用墙特征线。
在这里和那里，图形具有重复点（完全相同的X和Y，不同的Z）。我想找到他们并改变
Z值较高的图层，供以后用于绘制多段线和定义墙特征线。 这应该选择Z坐标值大于零的点。
(setq ss (ssget '((0 . "POINT")(-4 . "*,*,>")(10 0. 0. 0.))))
我绝对不会像你描述的那样创建列表。
也许是这样：
(defun c:maxz-dpt (/ l lst f r c x np xp ss i en ed)
(setq l "NEW-LAYER")
(and (setq ss (ssget '((0 . "POINT"))))
(setq i 0)
(while (setq en (ssname ss i))
(setq lst (cons (cdr (assoc 10 (entget en))) lst))
(setq i (1+ i))))
;;VVA
(defun round (num prec)
(* prec (if (minusp num)
(fix (- (/ num prec) 0.5))
(fix (+ (/ num prec) 0.5)))))
(initget 6)
(setq f (getdist "\nPoint Value Tolerence <0.001>: "))
(or f (setq f 0.001))
(setq c nil)
(foreach p lst
(setq r (list (round (car p) f)
(round (cadr p) f)))
(if (assoc r c)
(setq c (subst (append (assoc r c) (list (caddr p)))
(assoc r c) c))
(setq c (cons (append (list r) (list (caddr p))) c))))
(foreach p c
(setq x (append (car p) (list (apply 'max (cdr p)))))
(prin1 x)
(princ"\n")
(setq np (mapcar '- x (list f f f))
xp (mapcar '+ x (list f f f)))
(and (setq ss (ssget "X" (list (cons 0 "POINT")
(cons -4 "<AND")
(cons -4 ">=,>=,>=")
(cons 10 np)
(cons -4 "<=,<=,<=")
(cons 10 xp)
(cons -4 "AND>"))))
(setq en (ssname ss 0)
ed (entget en))
(entmod (subst (cons 8 l) (assoc 8 ed) ed))))
(prin1))
-大卫 You're welcome.Interesting project.
You should probably check to see if there any points already existing on the new layer.
I imagine this could be slow on a very large drawing.
Have fun ! -David I've run the code in a drawing that has 1341 points. It took less than 4 seconds on a core i7 laptop.
New layer has 1230 points, old layer has 111. All in all no duplicates in the same layer. Perfecto!
Thank you very much indeed. Now I'm going to learn the coding. Nice one David
The following may offer some performance improvements:
(defun c:dpz ( / a e f i l n p q s ) (setq n '(8 . "DPZ-LAYER") ;; New Layer f0.001 ;; Tolerance ) (if (setq s (ssget "_:L" '((0 . "POINT")))) (progn (repeat (setq i (sslength s)) (if (setq e (entget (ssname s (setq i (1- i)))) p (assoc 10 e) q (list (round (cadr p) f) (round (caddr p) f)) a (assoc q l) ) (if ( Thanks to you too Lee.
Your code ran instantly. Performance indeed improved.
Civil 3d event viewer notifies there are 107 duplicate points and your code found 107.
David's code found 111.
I don't think i have the required skill to find the cause yet.
页:
[1]
2