Topic: Selecting polylines overlapped by shorter polyline

[ifncdylan]

Hey all, I have a bit of a tricky one, I've been looking around the place for some examples of this but I can't seem to get anything together which works how I want.

I've attached some example lines here, there's a red polyline which is the duct and the rest of the polylines which are cables which run through the ducts, north to south. There's also some cables which are running across the duct east to west which I don't want to select. These lines are not always simple straight two vertex polylines and sometimes have extra vertexes, e.g. on the right.

The goal is to select all cables which are 'in' the red ducts - i.e. polylines that are running 'under' another polyline, but only along the length of it, and with some 'fuzz factor' as the lines are not always in the same place (they could be drawn slightly offset) and not always running parallel (sometimes they drawn on a slight angle).

Essentially I want to pick the lines underneath the red line (duct) but only include lines which are running along the length of the red line, not any crossing it in another direction, and include lines that are expanded.

A imagine perhaps a script which picks the middle two vertexes of the red line, and does a small box selection (the 'fuzz factor') on each and compares the two lists to return a list where it only includes the objects that are in both might work, however I'm not very good with curve/vertex functions so I haven't been able to figure out how to get the 'middle' vertexes which could also be the 'start/end' vertexes for a 2-point polyline.

Any pointers to some example functions to do this stuff would be greatly appreciated.

[ifncdylan]

Well, here's what I've come up with. It seems to work (on the two-box selection method), however I feel like it could be done more elegantly. It would be good if it didn't require zooming the window around as some drawings have 300k+ lines that need to be processed in this manner so the zoom method does work quite slowly - but hey, it works!

Thanks to all the people I nabbed some code knowledge from.. and as always.. thank you to Lee Mac, whose utility functions basically form the foundations of everything I do.

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun C:test ( / s i e v osm)
3.  
4.     (defun *error* ( msg )
5.         (if osm (setvar 'osmode osm))
6.                 (if (not (member msg '("Function cancelled" "quit / exit abort")))
7.                 (princ (strcat "\nError: " msg))
8.                 )
9.         (princ)
10.   )
11.  
12.   ;current view/snap settings
13.   (setq osm (getvar "osmode"))
14.   (setvar "osmode" 0)
15.  
16.   (cond
17.         ((and (setq s (ssget '((0 . "LWPOLYLINE"))))
18.          (setq view (LM:ViewportExtents)))
19.         (if (setq v (LM:ss->vla s))
20.                 (foreach o v
21.                         (if (setq u (DB:SelectLinesUnder o))
22.                                 (if (setq l (LM:ss->vla u))
23.                                         (foreach d l
24.                                                 (vla-put-color d acGreen)
25.                                         )
26.                                 )
27.                         )
28.                 )
29.           )
30.         ; restore view
31.          (vla-zoomwindow (vlax-get-acad-object) (vlax-3d-point (car view)) (vlax-3d-point (cadr view)))
32.     )
33.    (T
34.     (princ)
35.     )
36.    )
37.  
38.    (setvar "osmode" osm)
39. )
40.    
41. ; Input:        [ent]           - Polyline entity
42. ; Return:       [ss]            - selection set of objects
43.  
44. (defun DB:SelectLinesUnder ( ent / fuzz verts mid p1 p2 b1 b2 l1 l2 ss1 ss2 ss3 d1 osm)
45.  
46.   (defun *error* ( msg )
47.         (if osm (setvar 'osmode osm))
48.                 (if (not (member msg '("Function cancelled" "quit / exit abort")))
49.                 (princ (strcat "\nError: " msg))
50.                 )
51.         (princ)
52.   )
53.  
54.   (setq osm (getvar "osmode"))
55.   (setvar "osmode" 0)
56.  
57.   (if (= 'VLA-OBJECT (type ent)) (setq ent (vlax-vla-object->ename ent)))
58.   (setq fuzz 0.3)
59.  
60.   ;; zoom to the object so selections work
61.  
62.   (zoom-to ent)
63.   (setq verts (DB:lwvertices (entget ent)))
64.  
65.   ; get the middle vertices (lines with 2/3 verts returns first/last position
66.   (cond
67.     ((>= 3 (length verts))
68.         (setq p1 (nth 0 verts)
69.               p2 (last verts)
70.               )
71.      )
72.     ((< 3 (length verts))
73.         (setq mid (/ (1- (length verts)) 2)
74.               p1 (nth mid verts)
75.               p2 (nth (1+ mid) verts))
76.      )
77.   )
78.  
79.  
80.  
81.   ;create selection boxes at each point
82.   (setq b1 (GE_GetBoxAroundPt p1 fuzz fuzz 0))
83.   (setq b2 (GE_GetBoxAroundPt p2 fuzz fuzz 0))
84.   (setq ss1 (ssget "_F" b1 '((0 . "*LINE"))))
85.   (setq ss2 (ssget "_F" b2 '((0 . "*LINE"))))
86.  
87.   ; remove the original line from the sets
88.   (ssdel ent ss1)
89.   (ssdel ent ss2)
90.  
91.   ; compare lists for duplicates
92.   (setq l1 (LM:ss->vla ss1))
93.   (setq l2 (LM:ss->vla ss2))
94.   (setq d1 (DB:ListDupes l1 l2))
95.  
96.   ; build return sset from duplicates
97.   (setq ss3 (ssadd))
98.   (foreach obj d1
99.     (ssadd (vlax-vla-object->ename obj) ss3)
100.   )
101.   ;restore snap and zoom
102.   (setvar 'osmode osm)
103.  
104.   ;return value
105.   (if (and ss3 (> (sslength ss3) 0)) ss3 nil)
106.  
107.   )
108.  
109.  
110. (defun DB:ListDupes ( l1 l2 )
111.   (vl-remove-if-not '(lambda ( x ) (member x l2)) l1)
112. )      
113.  
114. ;; Returns a list of vertex points in a LWPolyline (simplified version of LM:lwvertices by Lee Mac)
115. (defun DB:lwvertices ( e )
116.     (if (setq e (member (assoc 10 e) e))
117.         (cons
118.                 (cdr (assoc 10 e))
119.             (DB:lwvertices (cdr e))
120.         )
121.     )
122. )
123.  
124. ;; create box around point (http://www.4d-technologies.com/techcenter/)
125. (defun GE_GetBoxAroundPt( pt dX dY Rot / p1 p2 p3 p4 halfX halfY _Rot )
126.  
127. (setq
128.         halfX (* 0.5 dX)
129.         halfY (* 0.5 dY)
130.         _Rot  (/ (* Rot pi) 180.0)
131.         p1    (polar pt (+ _Rot pi) halfX)
132.         p1    (polar p1 (+ _Rot (* 0.5 pi)) halfY)
133.         p2    (polar p1 _Rot dX)
134.         p3    (polar p2 (- _Rot (* 0.5 pi)) dY)
135.         p4    (polar p3 (+ _Rot pi) dX)
136. )
137. (list p1 p2 p3 p4)
138. )
139.  
140. (defun zoom-to (obj / lowleft upright)
141.   (if (eq (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj)))
142.   (vla-getboundingbox obj 'lowleft 'upright)
143.   (vlax-invoke-method (vlax-get-acad-object) 'zoomwindow lowleft upright)
144. )
145.  
146. ;; Viewport Extents  -  Lee Mac
147. ;; Returns two WCS points describing the lower-left and
148. ;; upper-right corners of the active viewport.
149.  
150. (defun LM:ViewportExtents ( / c h v )
151.     (setq c (trans (getvar 'viewctr) 1 0)
152.           h (/ (getvar 'viewsize) 2.0)
153.           v (list (* h (apply '/ (getvar 'screensize))) h)
154.     )
155.     (list (mapcar '- c v) (mapcar '+ c v))
156. )
157.  

[ronjonp]

Here's another way to do it. May give you some ideas.

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ _colinear _ss2l _foo _pts f pts2 r s1 s2 tmp)
2.   ;; RJP - 03.14.2018
3.   (defun _ss2l (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
4.   (defun _pts (e) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget e))))
5.   (defun _foo (e / p)
6.     (mapcar
7.       '(lambda (a b) (cons (mapcar '(lambda (c) (/ c 2.)) (mapcar '+ a b)) (rem (angle a b) pi)))
8.       (setq p (_pts e))
9.       (cdr p)
10.     )
11.   )
12.   (defun _colinear (p1 p2 p3 f) (equal (+ (distance p1 p2) (distance p2 p3)) (distance p1 p3) f))
13.   ;; Fuzz value for equality check
14.   (setq f 1e-2)
15.   (if
16.     (and (setq s1 (_ss2l (ssget '((0 . "lwpolyline") (62 . 1)))))
17.          (setq s2 (_ss2l (ssget "_A" '((0 . "lwpolyline") (-4 . "<NOT") (62 . 1) (-4 . "NOT>")))))
18.          (setq r (ssadd))
19.     )
20.      (foreach pt (apply 'append (mapcar '_foo s1))
21.        (setq tmp s2)
22.        (foreach pl s2
23.          (setq pts2 (_pts pl))
24.          (cond ((vl-some '(lambda (a b)
25.                             (and (_colinear a (car pt) b f) (equal (cdr pt) (rem (angle a b) pi) f))
26.                           )
27.                          pts2
28.                          (cdr pts2)
29.                 )
30.                 (setq tmp (vl-remove pl tmp))
31.                 (ssadd pl r)
32.                )
33.          )
34.        )
35.        (setq s2 tmp)
36.      )
37.   )
38.   (sssetfirst nil r)
39.   (princ)
40. )
41. (vl-load-com)

[ifncdylan]

Thanks ronjonp! Looks like a much better way to go about the selection method.

I'll try it out and see if I can understand how it's working - but I don't like my chances of that!