;; ptfix.lsp
;;
;; Fix inaccurate points in AutoCAD with this lisp routine
;; Select the elements you want to modify, click the desired point and add a tolerance. 
;; The points which are closer to the desired point than the tolerance will be moved to the desired point. 
;; Video about how it works: https://www.youtube.com/watch?v=iiLdYgVTKkc
;;
;; Created by Peter Gyetvai
;; gyetpet@gmail.com
;; gyetvai-peter.hu
;;
;; massoc routine created by Jason Piercey: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/getting-multiple-assoc-values/td-p/852437

(defun massoc (key alist / x nlist)
    (foreach x alist
        (if (eq key (car x))
            (setq nlist (cons (cdr x) nlist))
        )
    )
    (reverse nlist)
)

(defun C:ptfix (/ ss i il imax j jl jmax currElem currTyp currPoints currPointXY goodPoint goodPointXY tolerance currDist newPoint newElem movedPoints oldMovedPoints movedElems)
    ;variables:
    (setq i 0);counter to zero
    (setq imax 1);while variable
    (setq movedPoints 0)
    (setq movedElems 0)

    (vl-load-com)
    (graphscr)
    (prompt "\nSelect polylines: ")
    (setq ss (ssget));asks for selection
    (setq il (sslength ss));length of selection
    (setq goodPoint (getpoint "\nSelect desired point: "))
    (setq goodPointXY (vl-remove (last goodPoint) goodPoint))
    (setq tolerance (getdist "\nTolerance?"))
    
    (while imax
        (print )
        (princ "Checking element ")
        (princ i)

        (setq currElem (entget (ssname ss i) ))
        (setq currTyp (cdr (assoc 0 currElem)))
        (setq oldMovedPoints movedPoints)

        (print )
        (princ "  Element type: ")
        (princ currTyp)
        (cond
            (
                (= currTyp "LWPOLYLINE");if polyline
                (progn 
                    (setq currPoints (massoc 10 currElem))
                    ;; (print currPoints)
        
                    (setq jl (length currPoints))
                    (setq j 0);counter to zero
                    (setq jmax 1);while variable
                    (while jmax
                        (print )
                        (princ "    Checking point: ")
                        (princ (nth j currPoints))
                        
                        (setq currDist (distance (nth j currPoints) goodPointXY))
                        (if 
                            (and (< currDist tolerance) (/= currDist 0))
                            (progn
                                (setq newPoint (cons 10 goodPointXY))
                                (setq newElem(subst newPoint (cons 10 (nth j currPoints)) currElem))
                                (setq currElem newElem)
                                (entmod newElem)
                                (princ " - Point moved to desired location")
                                (setq movedPoints (1+ movedPoints))
                            )
                            (progn
                                (princ " - Point is farther than tolerance")
                            )
                        )

                        ;while specific: 
                        (setq j (1+ j));increments i
                        (if (= j jl) (setq jmax nil));finish function if i equals il
                    )
                    (if (/= oldMovedPoints movedPoints) (setq movedElems (1+ movedElems)))
                )
            );polyline end
            (
                (= currTyp "LINE") 
                (progn
                    (setq j 10)
                    (repeat 2 
                        (progn 
                            (setq currPoints (cdr (assoc j currElem)))
                            (print )
                            (princ "    Checking point: ")
                            (princ currPoints)
                            (setq currPointXY (vl-remove (last currPoints) currPoints))
                            (setq currDist (distance currPointXY goodPointXY))
                            
                            (if 
                                (and (< currDist tolerance) (/= currDist 0)) 
                                (progn
                                    (setq newPoint (cons j goodPoint))
                                    (setq newElem(subst newPoint (cons j currPoints) currElem))
                                    (setq currElem newElem)
                                    (entmod newElem)
                                   (princ " - Point moved to desired location")
                                    (setq movedPoints (1+ movedPoints))
                                )
                                (progn
                                   (princ " - Point is farther than tolerance")
                                )
                            )
                            (setq j 11)
                        )
                    )
                    (if (/= oldMovedPoints movedPoints) (setq movedElems (1+ movedElems)))
                )
            ); line end
            (progn
                (print )
                (princ "  This element is not line or polyline!")
            )
        )
    
        ;while specific: 
        (setq i (1+ i));increments i
        (if (= i il) (setq imax nil));finish function if i equals il
    )

    (terpri)
    (princ movedPoints)
    (princ " point(s) moved to the desired location")
    (terpri)
    (princ movedElems)
    (princ " element(s) modified")

    (setq ss nil)
     (princ)
)