Topic: help: Add Vertices to selected overlaping polylines at intersecting point

[PM]

hi. I use this code to add vertex on intersection of polylines, but this code works only for one polyline a time. Is it possible to select multyle polylines and insert to all the extra vertex?

Code - Auto/Visual Lisp: [Select]

1. ;;; pvx - adds vertices at intersection of pline and selection set of curves ;;;
2.  
3. (defun c:pvx ( / intersobj1obj2 LM:Unique AT:GetVertices member-fuzz add_vtx
4.                       s1 ss ent n entx intpts intptsall plpts par f )
5.  
6.   (vl-load-com)
7.  
8.   (defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
9.     (if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
10.     (if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
11.     (setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
12.     (if (vl-catch-all-error-p coords)
13.       (setq ptlst nil)
14.       (repeat (/ (length coords) 3)
15.         (setq pt (list (car coords) (cadr coords) (caddr coords)))
16.         (setq ptlst (cons pt ptlst))
17.         (setq coords (cdddr coords))
18.       )
19.     )
20.     ptlst
21.   )  
22.  
23.   (defun LM:Unique ( lst )
24.     (if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
25.   )
26.  
27.   (defun AT:GetVertices ( e / p l )
28.     (LM:Unique
29.       (if e
30.         (if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
31.           (repeat (setq p (1+ (fix p)))
32.             (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
33.           )
34.           (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
35.         )
36.       )
37.     )
38.   )
39.  
40.   (defun member-fuzz ( expr lst fuzz )
41.     (while (and lst (not (equal (car lst) expr fuzz)))
42.       (setq lst (cdr lst))
43.     )
44.     lst
45.   )
46.  
47.   (defun add_vtx ( obj add_pt ent_name / bulg sw ew )
48.       (vla-GetWidth obj (fix add_pt) 'sw 'ew)
49.       (vla-addVertex
50.           obj
51.           (1+ (fix add_pt))
52.           (vlax-make-variant
53.               (vlax-safearray-fill
54.                   (vlax-make-safearray vlax-vbdouble (cons 0 1))
55.                       (list
56.                           (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
57.                           (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
58.                       )
59.               )
60.           )
61.       )
62.       (setq bulg (vla-GetBulge obj (fix add_pt)))
63.       (vla-SetBulge obj
64.           (fix add_pt)
65.           (/
66.               (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
67.               (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
68.           )
69.       )
70.       (vla-SetBulge obj
71.           (1+ (fix add_pt))
72.           (/
73.               (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
74.               (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
75.           )
76.       )
77.       (vla-SetWidth obj (fix add_pt) sw (+ sw (* (- ew sw) (- add_pt (fix add_pt)))))
78.       (vla-SetWidth obj (1+ (fix add_pt)) (+ sw (* (- ew sw) (- add_pt (fix add_pt)))) ew)
79.       (vla-update obj)
80.   )
81.  
82.   (prompt "\nPick source POLYLINE...")
83.   (setq s1 (ssget "_+.:E:S:L" (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
84.   (while (not s1)
85.     (prompt "\nMissed... Try picking source POLYLINE on unlocked layer again...")
86.     (setq s1 (ssget "_+.:E:S:L" (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
87.   )
88.   (prompt "\nNow select intersecting curves...")
89.   (setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
90.   (while (not ss)
91.     (prompt "\nEmpty sel.set... Please reselect intersecting curves again...")
92.     (setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
93.   )
94.   (setq ent (ssname s1 0))
95.   (if (= (cdr (assoc 0 (entget ent))) "POLYLINE")
96.     (progn
97.       (command "_.CONVERTPOLY" "_L" ent "")
98.       (entupd (setq ent (entlast)))
99.       (vla-update (vlax-ename->vla-object ent))
100.       (setq f t)
101.     )
102.   )
103.   (repeat (setq n (sslength ss))
104.     (setq entx (ssname ss (setq n (1- n))))
105.     (setq intpts (intersobj1obj2 ent entx))
106.     (setq intptsall (append intpts intptsall))
107.   )
108.   (foreach intpt intptsall
109.     (setq plpts (AT:GetVertices ent))
110.     (if
111.       (and
112.         (not (member-fuzz intpt plpts 1e-6))
113.          (setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent intpt)))
114.       )
115.       (add_vtx (vlax-ename->vla-object ent) par ent)        
116.     )
117.   )
118.   (if f
119.     (progn
120.       (command "_.CONVERTPOLY" "_H" ent "")
121.       (entupd (setq ent (entlast)))
122.       (vla-update (vlax-ename->vla-object ent))
123.     )
124.   )
125.   (princ)
126. )
127.  
128.  

Thanks

[ribarm]

Here are my plintav*.lsp routines from my PLINETOOLS archive...
You should be able to achieve what you asked with some of them...

M.R.

[PM]

Thanks. What the differense between this 4 files. The plintav-new.lsp is the last version?