142 lines
5.4 KiB
Common Lisp
142 lines
5.4 KiB
Common Lisp
;; 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)
|
|
) |