[编程交流] 顶点重叠

([color=BLUE]defun[/color] c:vdupes ( [color=BLUE]/[/color] e i s )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
           ([color=BLUE]foreach[/color] x
               (LM:ListDupesFuzz
                   ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x)))
                       ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))))
                   )
                   1e-8
               )
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"CIRCLE"[/color])
                      '(8 . [color=MAROON]"Duplicate-Vertices"[/color]) [color=GREEN];; Layer[/color]
                       x
                      '(40 . 1.0) [color=GREEN];; Radius[/color]
                      '(62 . 1)   [color=GREEN];; Colour[/color]
                       ([color=BLUE]assoc[/color] 210 e)
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
[color=GREEN];; List Duplicates with Fuzz  -  Lee Mac[/color]
[color=GREEN];; Returns a list of items appearing more than once in a supplied list[/color]
([color=BLUE]defun[/color] LM:ListDupesFuzz ( l f [color=BLUE]/[/color] c r x )
   ([color=BLUE]while[/color] l
       ([color=BLUE]setq[/color] x ([color=BLUE]car[/color] l)
             c ([color=BLUE]length[/color] l)
             l ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( y ) ([color=BLUE]equal[/color] x y f)) ([color=BLUE]cdr[/color] l))
       )
       ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]length[/color] l) ([color=BLUE]1-[/color] c))
           ([color=BLUE]setq[/color] r ([color=BLUE]cons[/color] x r))
       )
   )
   ([color=BLUE]reverse[/color] r)
)
([color=BLUE]princ[/color])

(defun vs ( / e i s )
   (if (setq s (ssget  "_x" '((0 . "LWPOLYLINE"))))
       (repeat (setq i (sslength s))
           (foreach x
               (LM:ListDupesFuzz
                       (vl-remove-if-not '(lambda ( x ) (= 10 (car x)))
                       (setq e (entget (ssname s (setq i (1- i)))))  
  )
                1e-8
               )
               (entmake
                   (list
                      '(0 . "CIRCLE")
                      '(8 . "Duplicate-Vertices") ;; Layer
                       x
                      '(40 . 1.0) ;; Radius
                      '(62 . 1)   ;; Colour
                       (assoc 210 e)
                   )
               )
              (setq selpline2 (ssget "_x" (list '(0 . "CIRCLE")(cons 8 "Duplicate-Vertices")))) 
              (setq m 0)
              (repeat (sslength selpline2)       
                      (setq pline_ent2 (ssname selpline2 m))
                      (setq lis_ent2 (entget pline_ent2))
                      (Alert "Attention. Vertex superimposed. I will show through a Zoom.")
                      (COMMAND "ZOOM" "OBJECT" pline_ent2 "")
                      (exit)
              )
          )
       )
   )
   (princ)
)
;; List Duplicates with Fuzz  -  Lee Mac
;; Returns a list of items appearing more than once in a supplied list
(defun LM:ListDupesFuzz ( l f / c r x )
   (while l
       (setq x (car l)
             c (length l)
             l (vl-remove-if '(lambda ( y ) (equal x y f)) (cdr l))
       )
       (if (< (length l) (1- c))
           (setq r (cons x r))
       )
   )
   (reverse r)
)
(princ)