teknomatika 发表于 2022-7-5 16:20:25

Help - Select lines and overla

In the attached file, two lines are represented, apparently overlapping. In fact there is one out of the way between 0.0001.
Someonewill be able to achieve a routine that makes it possible to select thelines, overlapping them with the same y-coordinate. Of course, also for distant lines with other values.
This is an example for horizontal lines but needed equally for vertical lines.
 
Thanks!
 
test_lines.dwg

Lee Mac 发表于 2022-7-5 16:48:53

Not likely to be quick, but should work:
(defun c:linedupes ( / a f i l r s x )   (setq f 1e-3) ;; Fuzz   (if (setq s (ssget "_X" (list '(0 . "LINE") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))       (progn         (repeat (setq i (sslength s))               (setq x (entget (ssname s (setq i (1- i))))                     l (cons (list (cdr (assoc 10 x)) (cdr (assoc 11 x)) (cdr (assoc -1 x))) l)               )         )         (setq r (ssadd))         (while (setq a (car l))               (foreach b (setq l (cdr l))                   (if (or (and (equal (cara) (carb) f)                              (equal (cadr a) (cadr b) f)                           )                           (and (equal (cadr a) (carb) f)                              (equal (cara) (cadr b) f)                           )                     )                     (progn (ssadd (last a) r) (ssadd (last b) r))                   )               )         )         (if (< 0 (setq n (sslength r)))               (progn                   (princ (strcat "\n" (itoa n) " duplicate line" (if (= 1 n) "" "s") " found."))                   (sssetfirst nil r)               )               (princ "\nNo duplicate lines found.")         )       )   )   (princ))

teknomatika 发表于 2022-7-5 16:57:05

Lee,
Thanks for the attention. Always with fantastic solutions.
 
It works on the part of the selection. Furthermore, in a second step, I intend that once detected, the lines will be moved to overlap each other.
In summary, I want to detect the offset difference between the lines, overlap them and maintain, even if duplicated.
 
Thanks!

Lee Mac 发表于 2022-7-5 17:12:38

Assuming I've understood correctly, try the following:
(defun c:linedupes ( / a b f i l m p r s x )      (setq f 1e-3) ;; Fuzz      (if (setq s (ssget "_X" (list '(0 . "LINE") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))       (progn         (repeat (setq i (sslength s))               (setq x (entget (ssname s (setq i (1- i))))                     l (cons (list (cdr (assoc 10 x)) (cdr (assoc 11 x)) (assoc -1 x)) l)               )         )         (while (setq a (car l))               (foreach b (setq l (cdr l))                   (cond                     (   (and (equal (cara) (carb) f)                              (equal (cadr a) (cadr b) f)                           )                           (setq m (cons b m))                     )                     (   (and (equal (cadr a) (carb) f)                              (equal (cara) (cadr b) f)                           )                           (setq m (cons (list (cadr b) (car b) (last b)) m))                     )                   )               )               (if m (setq r (cons (cons a m) r) m nil))         )         (foreach x r               (setq p                   (mapcar                      '(lambda ( a b ) (cons a (avgpt b)))                      '(10 11)                     (list (mapcar 'car x) (mapcar 'cadr x))                   )               )               (foreach y x (entmod (cons (last y) p)))         )       )   )   (princ))(defun avgpt ( l )   (mapcar '(lambda ( x ) (/ x (length l))) (apply 'mapcar (cons '+ l))))(princ)

teknomatika 发表于 2022-7-5 17:23:45

Lee,
You really are the best. Thanks!
That's exactly it. To be even perfect for what I intend, I should also consider lines of different lengths. But it will already be wanting a lot.
页: [1]
查看完整版本: Help - Select lines and overla