Lisp - line endpoints to nearest nodes

October 16, 2015

Hello, we have a surveying program that draws lines from surveyed points by their codes. Because of programing error points and line endpoints do not match by a milimeter or so. Is it possible to make a lisp routine to move all line endpoints to nearest nodes?

Thank you!

October 16, 2015

Having been involved in commercial survey software there is just no excuse for points to not meet lines, doing a lisp fix is not the way to go, why have you not gone back to the software supplier ?

October 16, 2015

We tried, unfortunately it doesn't exist anymore, the supplier went bankrupt years ago.

October 18, 2015

Is it possible to make a lisp routine to move all line endpoints to nearest nodes?

can you attach example drawing monday?

alternatively this old code (lasso) stylus lwpolyline,

though not really helps


;acad2007. may not compatible to the latest acad version?
(defun c:nod2pl (/ 2d LWP p p1 l oos var val iso)
(setq
     var '(osmode pdmode pdsize)
     val (mapcar 'getvar var)
     ) ;_ end of setq

 (mapcar 'setvar var (list 8 [color="red"]99[/color] (* (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 10. )))
 (defun 2d (x) (list (car x) (cadr x)))
 (defun LWP (l)
   (entmakex (vl-list*	'(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		'(100 . "AcDbPolyline")
		'(70 . 0)
		(cons 90 (length l))
		(mapcar ''((x) (cons 10 x)) l)
		) ;_ end of vl-list*
      ) ;_ end of entmakex
   ) ;_ end of defun
 (if 
   (and
 (setq n (entsel "\nPick matched point code entity.."))
 (setq en (car n) p (cadr n))
 (= (cdr (assoc 0 (entget en))) "POINT")
 (setq iso (vl-cmdf "_layiso" en ""))
 ) ;_ end of and
   (while (= 5 (car (setq data (grread t 13 0))))
     (setq p1 (cadr data)
    p0 p1
    ) ;_ end of setq
     (if (setq p (osnap p1 "_nod"))
(setq l (append l (list (2d p))))
l
) ;_ end of if
     (grdraw p0 p1 2 0)
     ) ;_ end of while
(princ "\nNo point!? ")
   ) ;_ end of if
 (if l (lwp (setq l(LM:uniquefuzz (mapcar ''((x) (trans x 1 0)) l) 1e-6))))
 (redraw)
 (princ (strcat "\n" (itoa (length l)) " points joined.\n"))
 (mapcar 'setvar var val)
 (if iso (vl-cmdf "_layerp"))
 (princ)
 ) ;_ end of defun



;LM:uniquefuzz - Lee Mac
(defun LM:uniquefuzz (lst fuzz)
 (if lst
   (cons (car lst)
  (LM:uniquefuzz (vl-remove-if '(lambda (x) (equal x (car lst) fuzz)) (cdr lst)) fuzz)
  ) ;_ end of cons
   ) ;_ end of if
 ) ;_ end of defun

Edited December 16, 2015 by hanhphuc
pdmode 99 = better osnap?

October 18, 2015

Here is another, though it may be slow:

(defun c:endsnap ( / di1 di2 enx idx lst pt1 pt2 pt3 pts sel )
   (princ "\nSelect lines & points: ")
   (if (setq sel (ssget "_:L" '((0 . "LINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq enx (entget (ssname sel (setq idx (1- idx)))))
               (if (= "POINT" (cdr (assoc 0 enx)))
                   (setq pts (cons (cdr (assoc 10 enx)) pts))
                   (setq lst
                       (vl-list*
                           (cons (assoc 10 enx) (assoc -1 enx))
                           (cons (assoc 11 enx) (assoc -1 enx))
                           lst
                       )
                   )
               )
           )
           (foreach itm lst
               (setq pt1 (cdar itm)
                     pt2 (car  pts)
                     di1 (distance pt1 pt2)
               )
               (foreach pt3 (cdr pts)
                   (if (< (setq di2 (distance pt1 pt3)) di1)
                       (setq di1 di2
                             pt2 pt3
                       )
                   )
               )
               (entmod (list (cdr itm) (cons (caar itm) pt2)))
           )
       )
   )
   (princ)
)

Edited June 19, 2021 by Lee Mac

October 19, 2015

There is a bit of free survey software out there the "stringing" of lines and points is hard to find. Can you explain more what the software did, was the points from a data collector or csv PT,X,Y,Z,D

Was it a lisp is it compiled etc.

October 19, 2015

Thank you all for your replies, Lee Mac's lisp worked perfectly, you saved us quite a few hours of mind numbing labor and it isn't to slow since we have only few thousand points and lines per dwg file.

October 19, 2015

Thank you all for your replies, Lee Mac's lisp worked perfectly, you saved us quite a few hours of mind numbing labor and it isn't to slow since we have only few thousand points and lines per dwg file.

Excellent to hear!

June 17, 2021

Hello! I've found this lisp, endsnap by Lee Mac and it works perfectly. Thank's for that Lee Mac.

I'm trying to find a lisp that does the same thing, but with polylines, working only in the edges (polyline endpoints). It's possible to modify this endsnap lisp to do that?

On 10/18/2015 at 9:14 AM, Lee Mac said:

Here is another, though it may be slow:


([color=BLUE]defun[/color] c:endsnap ( [color=BLUE]/[/color] di1 di2 enx idx lst pt1 pt2 pt3 pts sel )
   ([color=BLUE]princ[/color] [color=MAROON]"\nSelect lines & points: "[/color])
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"LINE,POINT"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] enx ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx)))))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"POINT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 enx)))
                   ([color=BLUE]setq[/color] pts ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) pts))
                   ([color=BLUE]setq[/color] lst
                       ([color=BLUE]vl-list*[/color]
                           ([color=BLUE]cons[/color] ([color=BLUE]assoc[/color] 10 enx) ([color=BLUE]assoc[/color] -1 enx))
                           ([color=BLUE]cons[/color] ([color=BLUE]assoc[/color] 11 enx) ([color=BLUE]assoc[/color] -1 enx))
                           lst
                       )
                   )
               )
           )
           ([color=BLUE]foreach[/color] itm lst
               ([color=BLUE]setq[/color] pt1 ([color=BLUE]cdar[/color] itm)
                     pt2 ([color=BLUE]car[/color]  pts)
                     di1 ([color=BLUE]distance[/color] pt1 pt2)
               )
               ([color=BLUE]foreach[/color] pt3 ([color=BLUE]cdr[/color] pts)
                   ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] di2 ([color=BLUE]distance[/color] pt1 pt3)) di1)
                       ([color=BLUE]setq[/color] di1 di2
                             pt2 pt3
                       )
                   )
               )
               ([color=BLUE]entmod[/color] ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] itm) ([color=BLUE]cons[/color] ([color=BLUE]caar[/color] itm) pt2)))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

June 17, 2021

Like this example

June 19, 2021

I'm pleased that you find this program useful

The code could be modified in the following way to incorporate support for (LW) polylines:

(defun c:endsnap ( / di1 di2 ent enx idx lst pt1 pt2 pt3 pts sel )
   (princ "\nSelect lines & points: ")
   (if (setq sel (ssget "_:L" '((0 . "LINE,LWPOLYLINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq idx (1- idx)
                     ent (ssname sel idx)
                     enx (entget ent)
               )
               (cond
                   (   (= "POINT" (cdr (assoc 0 enx)))
                       (setq pts (cons (cdr (assoc 10 enx)) pts))
                   )
                   (   (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                       (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 10 (reverse enx)) ent)
                               lst
                           )
                       )
                   )
                   (   (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 11 enx) ent)
                               lst
                           )
                       )
                   )
               )
           )
           (foreach itm lst
               (setq pt1 (cdar itm)
                     pt2 (car  pts)
                     di1 (distance pt1 pt2)
               )
               (foreach pt3 (cdr pts)
                   (if (< (setq di2 (distance pt1 pt3)) di1)
                       (setq di1 di2
                             pt2 pt3
                       )
                   )
               )
               (entmod (subst (cons (caar itm) pt2) (car itm) (entget (cdr itm))))
           )
       )
   )
   (princ)
)

June 21, 2021

On 6/19/2021 at 8:29 PM, Lee Mac said:

I'm pleased that you find this program useful

The code could be modified in the following way to incorporate support for (LW) polylines:


(defun c:endsnap ( / di1 di2 ent enx idx lst pt1 pt2 pt3 pts sel )
   (princ "\nSelect lines & points: ")
   (if (setq sel (ssget "_:L" '((0 . "LINE,LWPOLYLINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq idx (1- idx)
                     ent (ssname sel idx)
                     enx (entget ent)
               )
               (cond
                   (   (= "POINT" (cdr (assoc 0 enx)))
                       (setq pts (cons (cdr (assoc 10 enx)) pts))
                   )
                   (   (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                       (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 10 (reverse enx)) ent)
                               lst
                           )
                       )
                   )
                   (   (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 11 enx) ent)
                               lst
                           )
                       )
                   )
               )
           )
           (foreach itm lst
               (setq pt1 (cdar itm)
                     pt2 (car  pts)
                     di1 (distance pt1 pt2)
               )
               (foreach pt3 (cdr pts)
                   (if (< (setq di2 (distance pt1 pt3)) di1)
                       (setq di1 di2
                             pt2 pt3
                       )
                   )
               )
               (entmod (subst (cons (caar itm) pt2) (car itm) (entget (cdr itm))))
           )
       )
   )
   (princ)
)

Thank you so much Lee Mac, grateful for that, works perfectly!!

Best Regards!

June 21, 2021

You're most welcome!

April 14, 2023

Is there a way to tweak this so it only looks for lines on a specific layer and moves the end point to the nearest node? I have a Pline on a layer called P-FBER-DROP. I need to snap the end points to the nearest node that has been placed in the center of a closed polygon

On 6/19/2021 at 7:29 PM, Lee Mac said:

I'm pleased that you find this program useful

The code could be modified in the following way to incorporate support for (LW) polylines:

(defun c:endsnap ( / di1 di2 ent enx idx lst pt1 pt2 pt3 pts sel )
   (princ "\nSelect lines & points: ")
   (if (setq sel (ssget "_:L" '((0 . "LINE,LWPOLYLINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq idx (1- idx)
                     ent (ssname sel idx)
                     enx (entget ent)
               )
               (cond
                   (   (= "POINT" (cdr (assoc 0 enx)))
                       (setq pts (cons (cdr (assoc 10 enx)) pts))
                   )
                   (   (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                       (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 10 (reverse enx)) ent)
                               lst
                           )
                       )
                   )
                   (   (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 11 enx) ent)
                               lst
                           )
                       )
                   )
               )
           )
           (foreach itm lst
               (setq pt1 (cdar itm)
                     pt2 (car  pts)
                     di1 (distance pt1 pt2)
               )
               (foreach pt3 (cdr pts)
                   (if (< (setq di2 (distance pt1 pt3)) di1)
                       (setq di1 di2
                             pt2 pt3
                       )
                   )
               )
               (entmod (subst (cons (caar itm) pt2) (car itm) (entget (cdr itm))))
           )
       )
   )
   (princ)
)

On 6/21/2021 at 2:11 PM, Lee Mac said:

You're most welcome!

April 16, 2023

On 4/14/2023 at 8:30 PM, Neil Stapley said:

Is there a way to tweak this so it only looks for lines on a specific layer and moves the end point to the nearest node? I have a Pline on a layer called P-FBER-DROP. I need to snap the end points to the nearest node that has been placed in the center of a closed polygon

Certainly - change this line:

(if (setq sel (ssget "_:L" '((0 . "LINE,LWPOLYLINE,POINT"))))

to:

(if (setq sel (ssget "_:L" '((-4 . "<OR") (0 . "POINT") (-4 . "<AND") (0 . "LINE,LWPOLYLINE") (8 . "P-FBER-DROP") (-4 . "AND>") (-4 . "OR>"))))

May 31, 2023

Dear LeeMac, i need a lisp very similar to the above. Can you help with a lisp that will move the endpoints of the lines I choose to anywhere I click?

I would be very grateful if you could take the time to help.

Edited May 31, 2023 by Husso

May 31, 2023

Untested, but should work...

(defun c:endlinstoclick ( / ss lins linspts pt lix)
  (if (setq ss (ssget "_:L" '((0 . "LINE"))))
    (progn
      (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq linspts (mapcar '(lambda (y) (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) y)) (mapcar 'entget lins)))
      (setq linspts (mapcar '(lambda (ent pts) (list ent (mapcar 'cdr pts))) lins linspts))
      (initget 1)
      (setq pt (trans (getpoint "\nPick or specify point to modify selected lines to match ends to it : ") 1 0))
      (foreach lipts linspts
        (if (< (distance pt (caadr lipts)) (distance pt (cadadr lipts)))
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 pt) (assoc 10 (setq lix (entget (car lipts)))) lix)))))
          (entupd (cdr (assoc -1 (entmod (subst (cons 11 pt) (assoc 11 (setq lix (entget (car lipts)))) lix)))))
        )
      )
    )
  )
  (princ)
)

Edited May 31, 2023 by marko_ribar

June 1, 2023

Thank you so much marko_ribar. Lisp works just fine.

Edited June 1, 2023 by Husso

December 7, 2023

On 6/20/2021 at 2:29 AM, Lee Mac said:

I'm pleased that you find this program useful

The code could be modified in the following way to incorporate support for (LW) polylines:

(defun c:endsnap ( / di1 di2 ent enx idx lst pt1 pt2 pt3 pts sel )
   (princ "\nSelect lines & points: ")
   (if (setq sel (ssget "_:L" '((0 . "LINE,LWPOLYLINE,POINT"))))
       (progn
           (repeat (setq idx (sslength sel))
               (setq idx (1- idx)
                     ent (ssname sel idx)
                     enx (entget ent)
               )
               (cond
                   (   (= "POINT" (cdr (assoc 0 enx)))
                       (setq pts (cons (cdr (assoc 10 enx)) pts))
                   )
                   (   (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                       (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 10 (reverse enx)) ent)
                               lst
                           )
                       )
                   )
                   (   (setq lst
                           (vl-list*
                               (cons (assoc 10 enx) ent)
                               (cons (assoc 11 enx) ent)
                               lst
                           )
                       )
                   )
               )
           )
           (foreach itm lst
               (setq pt1 (cdar itm)
                     pt2 (car  pts)
                     di1 (distance pt1 pt2)
               )
               (foreach pt3 (cdr pts)
                   (if (< (setq di2 (distance pt1 pt3)) di1)
                       (setq di1 di2
                             pt2 pt3
                       )
                   )
               )
               (entmod (subst (cons (caar itm) pt2) (car itm) (entget (cdr itm))))
           )
       )
   )
   (princ)
)

Hi, Lee Mac,

Is there a way the lisp shift only one end of the polyline to the nearest point. Presently it is moving both the start and end point of a polyline to the selected point. (My point has z value and the polyline is on 0 elevation)

Thanks

December 7, 2023

Yes - simply comment out (cons (assoc 10 enx) ent) or (cons (assoc 10 (reverse enx)) ent) depending on which end you don't wish to move.

Lisp - line endpoints to nearest nodes

Recommended Posts

herrkleinwolf

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL

Posted Images

BIGAL

Link to comment

Share on other sites

herrkleinwolf

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

herrkleinwolf

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

mrigorh

Link to comment

Share on other sites

mrigorh

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

mrigorh

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Neil Stapley

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Husso

Link to comment

Share on other sites

marko_ribar

Link to comment

Share on other sites

Husso

Link to comment

Share on other sites

CADWORKER

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity