Jump to content

Lisp - line endpoints to nearest nodes

herrkleinwolf

By herrkleinwolf
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

herrkleinwolf Newbie

herrkleinwolf

Posted
Posted

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!

  • Replies 28
  • Created
  • Last Reply

Top Posters In This Topic

  • BIGAL

    7

  • Lee Mac

    6

  • herrkleinwolf

    3

  • mrigorh

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL
BIGAL

Ok I still think adding control points would be better way to go as it would calc intermediate points, bearing in mind say for sample dwg creation would be instant. In my To do.

Posted Images

BIGAL Grand Master

BIGAL

Posted
Posted

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 ?

herrkleinwolf Newbie

herrkleinwolf

Posted
  • Author
Posted

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

hanhphuc Mentor

hanhphuc

Posted
Posted (edited)

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 by hanhphuc
pdmode 99 = better osnap?
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

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 by Lee Mac
BIGAL Grand Master

BIGAL

Posted
Posted

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.

herrkleinwolf Newbie

herrkleinwolf

Posted
  • Author
Posted

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. :D

Lee Mac Grand Master

Lee Mac

Posted
Posted
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. :D

 

Excellent to hear! :)

  • 5 years later...
mrigorh Rookie

mrigorh

Posted
Posted

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

 

 

Lee Mac Grand Master

Lee Mac

Posted
Posted

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

 

mrigorh Rookie

mrigorh

Posted
Posted
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!

  • 1 year later...
Neil Stapley Newbie

Neil Stapley

Posted
Posted

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!

 

Lee Mac Grand Master

Lee Mac

Posted
Posted
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>"))))

 

  • 1 month later...
Husso Rookie

Husso

Posted
Posted (edited)

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.

image.png.31c7adef254606c1bbf910fd92425f0d.png

Edited by Husso
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

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 by marko_ribar
Husso Rookie

Husso

Posted
Posted (edited)

Thank you so much marko_ribar. Lisp works just fine.

Edited by Husso
  • 6 months later...
CADWORKER Enthusiast

CADWORKER

Posted
Posted
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

Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...