Initial commit

2018-11-26 22:23:22 +01:00
parent 317403389d
commit 86753f6ca0
50 changed files with 4573 additions and 1 deletions
--- a/ptfix.lsp
+++ b/ptfix.lsp
@@ -0,0 +1,142 @@
+;; 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)
+)