lisp for multi trim and extend with condition

I have multi lines or polylines as to pic attached "before

I want to do trim or extend at all the intersection to become like this:

maybe should trim and extend with multiple edges and multiple trim or extend object with the condition: + all the line segments inside to edge will be trimed

+ all the line segments with length to intersection point is shorter than A will be trim

+ all the line which not another line but the distance from end point to another line is shorter than A will be extended.

Is there any lisp for that result?

Thank you for your attention

Only thing I can think and I think it may help you, if anything is these steps I suggest you to try...

1. Explode all linear entities - you should have only lines...

2. Use PEDIT -> Multiple option and select all lines...

3. Use here posted plintav-new.lsp and select all converted lwpolylines...

4. Explode all lwpolylines...

5. Use REGION command and select all lines...

6. Use QSELECT command - leave option to be applied to whole drawing, in object type choose REGION, in filter below use option to SELECT ALL, and finally choose EXCLUDE option in buttons... => All entities except REGIONS will be selected => hit del. key...

7. With REGIONS remained operate what you want - erase ones that are sufficient, use union, subtract, intersect, etc...

8. Finally explode them back into lines (I suspected that starting entities belong to lines, if not than explode only those regions you want...)

9. Use trim (with built in options like "FENCE" for ex.), extrim, wptrim (search www. for this code - I posted one as I can remember on www.augi.com), or exb2c (extrim between 2 curves - posted here in my recent post), or mextrim (also posted here on www.cadtutor.net)

10. After trim look for lines needed to be extended (EXTEND command)...

Here is my plintav-new.lsp (New is because it can now add vertices and on start/end points of intersecting polylines - check if 2 plines are colinear and overlap each other)...

(defun c:plintav-new ( / intersobj1obj2 LM:Unique AT:GetVertices add_vtx clean_poly
                        ss sslpl sshpl i ent n ent1 ss-ent1 k ent2 intpts intptsall pl plpts par )

 (vl-load-com)

 (defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
   (if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
   (if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
   (setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
   (if (vl-catch-all-error-p coords)
     (setq ptlst nil)
     (repeat (/ (length coords) 3)
       (setq pt (list (car coords) (cadr coords) (caddr coords)))
       (setq ptlst (cons pt ptlst))
       (setq coords (cdddr coords))
     )
   )
   ptlst
 )

 (defun LM:Unique ( lst )
   (if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
 )

 (defun AT:GetVertices ( e / p l )
   (LM:Unique
     (if e
       (if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
         (repeat (setq p (1+ (fix p)))
           (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
         )
         (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
       )
     )
   )
 )

 (defun add_vtx ( obj add_pt ent_name / bulg sw ew )
     (vla-GetWidth obj (fix add_pt) 'sw 'ew)
     (vla-addVertex
         obj
         (1+ (fix add_pt))
         (vlax-make-variant
             (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 1))
                     (list
                         (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                         (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                     )
             )
         )
     )
     (setq bulg (vla-GetBulge obj (fix add_pt)))
     (vla-SetBulge obj
         (fix add_pt)
         (/
             (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
             (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
         )
     )
     (vla-SetBulge obj
         (1+ (fix add_pt))
         (/
             (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
             (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
         )
     )
     (vla-SetWidth obj (fix add_pt) sw (+ sw (* (- ew sw) (- add_pt (fix add_pt)))))
     (vla-SetWidth obj (1+ (fix add_pt)) (+ sw (* (- ew sw) (- add_pt (fix add_pt)))) ew)
     (vla-update obj)
 )

 (defun clean_poly ( ent / trunc e_lst p_lst )

   (defun trunc ( expr lst )
     (if (and lst (not (equal (car lst) expr)))
       (cons (car lst) (trunc expr (cdr lst)))
     )
   )

   (setq e_lst (entget ent))
   (if (= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
     (progn
       (setq p_lst 
                   (vl-remove-if-not 
                    '(lambda (x)
                       (or (= (car x) 10)
                           (= (car x) 40)
                           (= (car x) 41)
                           (= (car x) 42)
                       )
                     )
                     e_lst
                   )
             e_lst 
                   (vl-remove-if
                    '(lambda (x)
                       (member x p_lst)
                     )
                     e_lst
                   )
       )
       (if (= 1 (logand (cdr (assoc 70 e_lst)) 1))
         (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
           (setq p_lst (reverse (cdr (member (assoc 10 (reverse p_lst)) (reverse p_lst)))))
         )
       )
       (while p_lst
         (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
               p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
         )
       )
       (entmod e_lst)
     )
   )
   (princ)
 )

 (setq ss (ssget "_: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")))))
 (setq sslpl (ssadd) sshpl (ssadd))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
     (progn
       (entupd ent)
       (vla-update (vlax-ename->vla-object ent))
       (ssadd ent sslpl)
     )
   )
   (if (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
     (ssadd ent sshpl)
   )
 )
 (setq i -1)
 (while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "l" ent "")
   (entupd ent)
   (vla-update (vlax-ename->vla-object ent))
   (ssadd ent sslpl)
 )
 (repeat (setq n (sslength ss))
   (setq ent1 (ssname ss (setq n (1- n))))
   (setq ss-ent1 (ssdel ent1 ss))
   (repeat (setq k (sslength ss-ent1))
     (setq ent2 (ssname ss-ent1 (setq k (1- k))))
     (setq intpts (intersobj1obj2 ent1 ent2))
     (setq intptsall (append intpts intptsall))
   )
 )
 (setq i -1)
 (while (setq pl (ssname sslpl (setq i (1+ i))))
   (setq plpts (AT:GetVertices pl))
   (setq intptsall (append plpts intptsall))
 )
 (setq i -1)
 (while (setq pl (ssname sslpl (setq i (1+ i))))
   (foreach pt intptsall
     (if (setq par (vlax-curve-getparamatpoint pl pt))
       (add_vtx (vlax-ename->vla-object pl) par pl)
     )
   )
 )
 (repeat (setq n (sslength sslpl))
   (clean_poly (ssname sslpl (setq n (1- n))))
 )
 (setq i -1)
 (while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "h" ent "")
 )
 (princ)
)

HTH, M.R.

Tks many for your reply.

But when I use plintav-new.lsp it return the error like this:

" Command: plintav-new

Select objects: Specify opposite corner: 183 found

Select objects:

; error: bad argument type: 2D/3D point: nil "

Do you know what problem is? and what is the purpose of this lisp?

I also wanna make clear about the PEDIT commmand. It help to convert all lines to polylines, rite? So after PEDIT and chose all, what option to do next (open/ Close// fit...)?

I guest that you wanna make all the quadrangle( creat from 4 intersection of lines) become Regions for easy to delete?

Kindly let me know your idea? Thanks for your help.

Rgs

Your entities on which you need to apply plintav-new.lsp are lwpolylines... So you simply create them with PEDIT command, choose "M" - multiple and select all LINES then just tap ENTER twice... All lines will be converted to lwpolylines, after this you can apply plintav-new.lsp...

M.R.

EDIT : The purpose of plintav-new.lsp is to add vertices on all intersections of selected lwpolylines and new is because it's applicable and on colinear lwpolylines - vertices are added where is position of start/end vertex of another lwpolyline that interfere and that is colinear... To see what plintav.lsp (not "new") does, look this video on Youtube...

http://www.cadtutor.net/forum/showthread.php?67924-Draw-polyline-along-with-2-or-more-adjacent-closed-polylines/page3&p=#28

Tks for your reply. I got it. It may help very much on all the cases of 4 interfere lwpolylines to make 4 vertex. But it also create short lwpolylines at the end, right next outside of interfere. So the problems is how to remove all short lwpolylines?

And the remains case are with lwpolylines which not interfere others (it should), need to be extended and take much times because on my situation there are many.

2. I still cannot use your plintav-new, it always return the 2 errors:

" Command: plintav-new

Select objects: Specify opposite corner: 4 found

Select objects:

; error: no function definition: TRUNC"

or " Command: PLINTAV-NEW

Select objects: Specify opposite corner: 137 found

Select objects:

; error: bad argument type: 2D/3D point: nil"

A simpler suggestion is to break the lines as you draw them you would need a lisp though, draw a line and offset and break I will see what I can provide I have a solution but its copyrited. From a architectural point this is common for wall intersections.

@BIGAL: Thanks. But I still did not get your suggestion. I need to draw the layout of road map system after redraw base on inserted google map pictures as below:

Kindly help if you have any solution.

trunglupin, sorry for I didn't included (trunc) inside my (clean_poly) subfunctions... Now fixed, thanks for checking, you may try plintav-new.lsp now...

Kind regards, M.R.

yep. Tks very much Marko ribar, now no problem with plintav-new.lsp. It solds the case of carrefour intersection. after use plintav-new, I can use quick select to chose all the very short lines made of new vertex.

but with the T junction, you will only wanna delete 3 lines inside of T junction (it is deferent with the carrefour intersection: delete 4 lines), and also there are still remain 2 end segments of the 2 polylines you wanna delete.

Do you have any suggestion for this?

My suggestion was based on you drawing lines you did not say you were getting from some other source like google map.

Re short lines can check for length of lines if less than a value then erase but could delete some wanted.