[编程交流] Fas-连接水平和ve

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