Help - Select lines and overla

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

In the attached file, two lines are represented, apparently overlapping. In fact there is one out of the way between 0.0001.
Someone will be able to achieve a routine that makes it possible to select the lines, 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:

copy

(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 (car  a) (car  b) f)                                (equal (cadr a) (cadr b) f)                           )                           (and (equal (cadr a) (car  b) f)                                (equal (car  a) (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:

copy

(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 (car  a) (car  b) f)                                (equal (cadr a) (cadr b) f)                           )                           (setq m (cons b m))                       )                       (   (and (equal (cadr a) (car  b) f)                                (equal (car  a) (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.

[编程交流] Help - Select lines and overla

发表回复

精选推荐