Fas- connect horizontal and vertical aligned points

[ctdlc888]

Hi experts, Need lisp to fast-connect points that are ALMOST horizontal or vertical aligned. It will ask for 1)pick first point 2) Go North, South, East or West 3) fuzz/tolerance distance left or right of direction. Illustration attached. Thank you

 

Erratum: In the title, 'Fas' should be 'Fast'. Thanks

ConnectLine.dwg

[marko_ribar]

You have duplicate points, so I did OVERKILL, and moreover your points are far away from WCS basepoint (0.0 0.0 0.0), so I moved all entities to be applicable for my code... It worked for me for fuzz factor : 1e-2... I'll attach my version of DWG...

 

(defun c:fpgl nil (c:fillpointgridwithlines))
(defun c:fillpointgridwithlines ( / osm ape *error* fuzz ss k entpt pt ptlst ptcllst ptcl1 ptcl2 ptcl3 ptcl4 )
 (setq osm (getvar 'osmode))
 (setq ape (getvar 'aperture))
 (setvar 'osmode 0)
 (setvar 'aperture 1)
 (defun *error* ( msg )
   (if osm (setvar 'osmode osm))
   (if ape (setvar 'aperture ape))
 )
 (prompt "\nSelect points for grid connection with lines")
 (while (not (setq ss (ssget '((0 . "POINT"))))))
 (initget 7)
 (setq fuzz (getreal "\nEnter fuzz factor (1e-1...1e-10) : "))
 (setq k -1)
 (while (and (setq entpt (ssname ss (setq k (1+ k)))) (< k (sslength ss)))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (foreach pt ptlst
   (setq ptcl1 (nth 1 (setq ptcllst (vl-sort ptlst '(lambda ( a b ) (< (distance pt a) (distance pt b)))))))
   (setq ptcl2 (nth 2 ptcllst))
   (setq ptcl3 (nth 3 ptcllst))
   (setq ptcl4 (nth 4 ptcllst))
   (if (or (equal (angle pt ptcl1) 0.0 fuzz) (equal (angle pt ptcl1) (* 0.5 pi) fuzz) (equal (angle pt ptcl1) pi fuzz) (equal (angle pt ptcl1) (* 1.5 pi) fuzz) (equal (angle pt ptcl1) (* 2.0 pi) fuzz))
     (if (not (ssget (mapcar '/ (mapcar '+ pt ptcl1) '(2.0 2.0 2.0)) '((0 . "LINE"))))
       (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl1)))
     )
   )
   (if (or (equal (angle pt ptcl2) 0.0 fuzz) (equal (angle pt ptcl2) (* 0.5 pi) fuzz) (equal (angle pt ptcl2) pi fuzz) (equal (angle pt ptcl2) (* 1.5 pi) fuzz) (equal (angle pt ptcl2) (* 2.0 pi) fuzz))
     (if (not (ssget (mapcar '/ (mapcar '+ pt ptcl2) '(2.0 2.0 2.0)) '((0 . "LINE"))))
       (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl2)))
     )
   )
   (if (or (equal (angle pt ptcl3) 0.0 fuzz) (equal (angle pt ptcl3) (* 0.5 pi) fuzz) (equal (angle pt ptcl3) pi fuzz) (equal (angle pt ptcl3) (* 1.5 pi) fuzz) (equal (angle pt ptcl3) (* 2.0 pi) fuzz))
     (if (not (ssget (mapcar '/ (mapcar '+ pt ptcl3) '(2.0 2.0 2.0)) '((0 . "LINE"))))
       (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl3)))
     )
   )
   (if (or (equal (angle pt ptcl4) 0.0 fuzz) (equal (angle pt ptcl4) (* 0.5 pi) fuzz) (equal (angle pt ptcl4) pi fuzz) (equal (angle pt ptcl4) (* 1.5 pi) fuzz) (equal (angle pt ptcl4) (* 2.0 pi) fuzz))
     (if (not (ssget (mapcar '/ (mapcar '+ pt ptcl4) '(2.0 2.0 2.0)) '((0 . "LINE"))))
       (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt) (cons 11 ptcl4)))
     )
   )
 )
 (*error* nil)
(princ)
)
(prompt "\nInvoke c:fillpointgridwithlines with shortcut c:fpgl ; \"Type only\" Command: fpgl")
(princ)

M.R.

ConnectLine-MR.dwg

[ctdlc888]

Greetings. Marko it worked in my attached file even without moving entities, and relieved the prompts i suggested.Great