Add Vertices to selected polyline at intersecting Lines

[Hannan1]

Hello Gents,

Can some one have Lisp to Add Vertices to selected polyline on intersecting Lines all other lines like (LW, 2D, 3D and Line),

For Example Like which is in Before and After Screen short.

[SeeMSixty7]

Ok, I have watched your other topic for placing text at the intersections, but now I have to ask, Why do you want to add a vertex at each intersecting point. It seems like you are working toward an end result, but via piece meal. Rather than having people develop each step that you have come up with to get to your end result. Perhaps you could show your start and end result you are ultimately looking for, not just this steps end result. There is perhaps an easier or better method when considering Programing options to get something done, just automating the steps you would take manually is not automating an effort. It is automating a manual processes, that may or may not be efficient to begin with.

So my advice is show some of the people here what your overall goal is, instead of the approach of how do I do this, ok now how about this, ok what about this, now this, and on and on and on.

Good luck and I hope that make sense,

[john.uhden]

Now now.  You may be thinking this too far.  Perhaps he just likes vertices so that when he grips a polyline it lights up his screen.  He might love learning to use sssetfirst.

Someone should really kick me oughta here.

[SeeMSixty7]

I think you need to be bumped up to moderator! LOL

[Hannan1]

Because I want to make XYZ report which which is crossings to propose line ,
And I want to do QC is there any missing when we are doing manually ,
If we have piece's of steps then we can play and we can use those steps in different different places.

[SeeMSixty7]

Fair enough on the XYZ reporting.

Just a suggestion, consider a NODE Type Block, to be inserted at the intersections, instead, then you could use DATAEXTRACTION or a customized routine to get the data of those blocks, you could also populate attribute data into those blocks as desired using the routine you already have. You can quickly see those blocks via a selection and if you use an actual POINT (NODE) as the graphic or actual line work you can see them graphically, with tweaks to PDMODE and PDSIZE or via Layer Controls, again all those could be associated to layers and actual 3D points. Lots of control and benefits. Plus side is you already have the code to get the intersections and the layer data to populate and  / or insert a block at each point. All you need to do is create the block and what you want in the block, a little more code to insert the blocks and you are done. DATAEXTRACTION output to excel and you can report on and QC your data visually and with a spreadsheet.

Hope that helps,

[Ranjit_Singh · Accepted solution]

I adjusted the code I provided here. See if it helps.

;;Add layer names and insert vertices
;;Ranjit Singh
;;05/17/17
(defun c:somefunc  (/ curosmode cur3osmode vlaobj ent ent2 ent3 etdata lst ss1)
 (setq curosmode (getvar 'osmode) cur3osmode (getvar '3dosmode))
 (setvar 'osmode 16384)
 (setvar '3dosmode 1)
 (command "._zoom" "_obj" (setq ent (car (entsel "\nSelect intersecting polyline: "))) "")
 (setq etdata (entget (setq ent2 ent)))
 (cond ((= "POLYLINE" (cdr (assoc 0 etdata)))
        (while (/= "SEQEND" (cdr (assoc 0 (setq etdata (entget (setq ent (entnext ent)))))))
         (setq lst (cons (cdr (assoc 10 etdata)) lst))))
       ((wcmatch (cdr (assoc 0 etdata)) "LINE,LWPOLYLINE")
        (setq lst (cdr (reverse (vl-remove-if-not 'listp (mapcar 'cdr etdata))))))
       (t ()))
 (if lst
  (mapcar '(lambda (x)
            (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") (cons 8 (caddr x)) '(100 . "AcDbMText") (cons 10 (cadddr x)) (cons 1 (caddr x)) '(7 . "ROMANS") (cons 50 (car x)) '(71 . 8)))
            (if ent3
             (entdel ent3))
            (setq ent3 (entmakex '((0 . "LINE") (10 0.0 0.0 0.0) (11 1.0 1.0 0.0))))
            (if (wcmatch (cdr (assoc 0 (entget (cadr x)))) "LINE,LWPOLYLINE")
             (progn (command-s "._break" (cadr x) (cadddr x) "@") (command-s "._join" (entlast) (cadr x) ""))
             (progn (command-s "._break" (cadr x) (cadddr x) "@")
                    (command-s "._join" (entlast) (entnext ent3) "")
(command-s "._pedit" (entlast) "_j" (entnext ent3) "" ""))))
          (mapcar '(lambda (x)
                    (setq vlaobj (vlax-ename->vla-object (car x)))
                    (cons (angle '(0 0)
                                 (car
                                  (mapcar '(lambda (x)
                                            (if (minusp (car x))
                                             (mapcar '* '(-1 -1) x)
                                             x))
                                          (list
                                           (vlax-curve-getfirstderiv vlaobj
                                                                     (vlax-curve-getparamatpoint vlaobj (vlax-curve-getclosestpointto vlaobj (last x))))))))
                          x))
                  (mapcar '(lambda (x) (cons (cadr x) (cons (cdr (assoc 8 (entget (cadr x)))) (cdr (cadddr x)))))
                          (vl-remove-if '(lambda (x) (equal ent2 (cadr x)))
                                        (ssnamex (setq ss1 (ssget "_f" lst '((0 . "*LINE"))))))))))
 (setvar 'osmode curosmode)
 (setvar '3dosmode cur3osmode)
 (entdel ent3)
 (sssetfirst nil (ssdel ent2 (setq ss1 (ssget "_f" lst '((0 . "*LINE"))))))
 (princ))

[Hannan1]

Thank you very much Ranjit sir, improve this code , But this code is for before i posted that topic ,(Intersecting polylines to be select and Layer name to Label with same layer name) ya this also pretty good 

But here for this topic (Add Vertices to selected poly-line at intersecting Lines) it is not adding vertex to selected poly-line ,

you can check by selecting that arrow poly-line you can see selection vertex Before and After in attached drawing file .

[marko_ribar · Accepted solution]

Untested modification of my plintav.lsp... Try it, it may work as desired...

;;; plintav1 - adds vertices at intersection of pline and selection set of curves ;;;

(defun c:plintav1 ( / intersobj1obj2 LM:Unique AT:GetVertices member-fuzz add_vtx
                      s1 ss ent n entx intpts intptsall plpts par f )

  (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 member-fuzz ( expr lst fuzz )
    (while (and lst (not (equal (car lst) expr fuzz)))
      (setq lst (cdr lst))
    )
    lst
  )

  (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)
  )

  (prompt "\nPick source POLYLINE...")
  (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")))))
  (while (not s1)
    (prompt "\nMissed... Try picking source POLYLINE on unlocked layer again...")
    (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")))))
  )
  (prompt "\nNow select intersecting curves...")
  (setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
  (while (not ss)
    (prompt "\nEmpty sel.set... Please reselect intersecting curves again...")
    (setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
  )
  (setq ent (ssname s1 0))
  (if (= (cdr (assoc 0 (entget ent))) "POLYLINE")
    (progn
      (command "_.CONVERTPOLY" "_L" ent "")
      (entupd (setq ent (entlast)))
      (vla-update (vlax-ename->vla-object ent))
      (setq f t)
    )
  )
  (repeat (setq n (sslength ss))
    (setq entx (ssname ss (setq n (1- n))))
    (setq intpts (intersobj1obj2 ent entx))
    (setq intptsall (append intpts intptsall))
  )
  (foreach intpt intptsall
    (setq plpts (AT:GetVertices ent))
    (if 
      (and
        (not (member-fuzz intpt plpts 1e-6))
        (setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt)))
      )
      (add_vtx (vlax-ename->vla-object ent) par ent)        
    )
  )
  (if f
    (progn
      (command "_.CONVERTPOLY" "_H" ent "")
      (entupd (setq ent (entlast)))
      (vla-update (vlax-ename->vla-object ent))
    )
  )
  (princ)
)

HTH., M.R.

[Hannan1]

Getting error

(Select objects:  ; error: bad argument type: 2D/3D point: nil)

[marko_ribar · Accepted solution]

I told that's untested...

Try this from what I saw :

Change this :

(setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt)))

To this :

(setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent intpt)))

[Hannan1]

WOW.....wonderful Thankq you very much its working.

[Anonymous]

Hi,

Is there a way for this work on more than one polyline at a time? So you select multiple polylines (such as cross section location lines) and vertices are added on all of them depending on where they intersect the lines beneath?

I managed to edit the code to allow selection of more than one polyline at the start of the command but it only adds points on the last line selected.

Thanks

[Anonymous]

Hi, 

Just wanted to know if it is possible to apply the function to multiple objects?

[aaron_gonzalez]

Ranjit, could you modify the lisp for show the length of each pline after the layer name, please

[john.uhden]

Careful there, @Ranjit_Singh ,
As I have recently learned by skinning my knees, you can't break a closed polyline at one point. Same is true for a circle.